From ce6adaea2818f9991011fdde339655ceb57a7fef Mon Sep 17 00:00:00 2001 From: ericward-noaa Date: Fri, 16 Oct 2026 07:20:57 -0700 Subject: [PATCH 1/4] create initial versions of composition plots --- NAMESPACE | 6 + R/data.R | 23 + R/plot_comp.R | 653 ++++++++++++++++++++++++++ R/utils_comp.R | 427 +++++++++++++++++ data-raw/example_comp_data.R | 70 +++ data/example_comp_data.rda | Bin 0 -> 9192 bytes man/example_comp_data.Rd | 34 ++ man/plot_comp.Rd | 84 ++++ man/plot_comp_bubble.Rd | 70 +++ man/plot_comp_mean.Rd | 85 ++++ man/plot_comp_residuals.Rd | 35 ++ man/plot_comp_sex_ratio.Rd | 71 +++ man/prepare_comp_data.Rd | 87 ++++ pkgdown/_pkgdown.yml | 2 + tests/testthat/test-plot_comp.R | 181 +++++++ vignettes/composition_diagnostics.Rmd | 177 +++++++ 16 files changed, 2005 insertions(+) create mode 100644 R/plot_comp.R create mode 100644 R/utils_comp.R create mode 100644 data-raw/example_comp_data.R create mode 100644 data/example_comp_data.rda create mode 100644 man/example_comp_data.Rd create mode 100644 man/plot_comp.Rd create mode 100644 man/plot_comp_bubble.Rd create mode 100644 man/plot_comp_mean.Rd create mode 100644 man/plot_comp_residuals.Rd create mode 100644 man/plot_comp_sex_ratio.Rd create mode 100644 man/prepare_comp_data.Rd create mode 100644 tests/testthat/test-plot_comp.R create mode 100644 vignettes/composition_diagnostics.Rmd diff --git a/NAMESPACE b/NAMESPACE index 2bdb74bb..37474713 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,11 @@ export(plot_abundance_at_age) export(plot_biomass) export(plot_biomass_at_age) export(plot_catch_comp) +export(plot_comp) +export(plot_comp_bubble) +export(plot_comp_mean) +export(plot_comp_residuals) +export(plot_comp_sex_ratio) export(plot_discard) export(plot_fishing_mortality) export(plot_index) @@ -23,6 +28,7 @@ export(plot_selectivity) export(plot_spawning_biomass) export(plot_stock_recruitment) export(plot_timeseries) +export(prepare_comp_data) export(process_data) export(process_table) export(reference_line) diff --git a/R/data.R b/R/data.R index aa90d1e6..a182e4f8 100644 --- a/R/data.R +++ b/R/data.R @@ -41,3 +41,26 @@ #' } #' "example_data" + +#' Example composition data +#' +#' Simulated sex-specific age compositions for a fishery (2001-2020) and a +#' survey (2005-2020), used to demonstrate the composition plotting +#' functions. Observed fishery compositions were generated with dome-shaped +#' selectivity while the expected values assume asymptotic selectivity, so +#' the fishery shows a pattern of misfit at older ages. See +#' `data-raw/example_comp_data.R` for the simulation code. +#' +#' @format A tibble with 1080 rows and 8 variables: +#' \describe{ +#' \item{comp_type}{Type of composition ("age")} +#' \item{fleet}{Fleet or survey name} +#' \item{year}{Year of the observation} +#' \item{sex}{"female" or "male"; proportions sum to one across both sexes within a year and fleet} +#' \item{bin}{Age bin} +#' \item{observed}{Observed proportion} +#' \item{expected}{Model-expected proportion} +#' \item{n}{Input sample size} +#' } +#' @seealso [prepare_comp_data()], [plot_comp()] +"example_comp_data" diff --git a/R/plot_comp.R b/R/plot_comp.R new file mode 100644 index 00000000..83d42ec8 --- /dev/null +++ b/R/plot_comp.R @@ -0,0 +1,653 @@ +#' Plot composition distributions +#' +#' Plot age or length compositions as distributions (proportion by bin), one +#' panel per year, optionally overlaying the model-expected values. Setting +#' `aggregate = TRUE` instead sums the compositions across years so that each +#' fleet is summarized in a single panel. +#' +#' @param dat A data frame of composition data in any format accepted by +#' [prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` +#' table, or a tidy data frame like [example_comp_data]. +#' @param show_expected Logical. TRUE/FALSE; overlay the expected values as +#' lines. Ignored if `dat` contains no expected values. +#' +#' Default: TRUE +#' +#' @param aggregate Logical. TRUE/FALSE; aggregate compositions across years +#' within each fleet. Years are weighted by their sample size when sample +#' sizes are available. +#' +#' Default: FALSE +#' +#' @param show_n Logical. TRUE/FALSE; label each panel with its sample size +#' when sample sizes are available (not used when `aggregate = TRUE`). +#' +#' Default: TRUE +#' +#' @param ncol Number. Number of facet columns. NULL lets `ggplot2` choose. +#' +#' Default: NULL +#' +#' @inheritParams prepare_comp_data +#' +#' @returns A `ggplot2` object. +#' +#' @details When compositions are sex-specific (both "female" and "male" +#' values in the `sex` column), females are plotted above zero and males +#' below zero. Bars show observed proportions and lines show expected +#' proportions. +#' +#' If more than one fleet is plotted without aggregating, panels are +#' created for every fleet and year combination; use `fleet` to focus on one +#' fleet at a time. +#' +#' @seealso [prepare_comp_data()], [plot_comp_bubble()], +#' [plot_comp_residuals()], [plot_comp_sex_ratio()], [plot_comp_mean()] +#' @export +#' +#' @examples +#' # Observations only +#' plot_comp(example_comp_data, fleet = "Survey", show_expected = FALSE) +#' +#' # Observed and expected +#' plot_comp(example_comp_data, fleet = "Fishery") +#' +#' # All fleets aggregated across years +#' plot_comp(example_comp_data, aggregate = TRUE) +plot_comp <- function( + dat, + show_expected = TRUE, + aggregate = FALSE, + comp_type = NULL, + fleet = NULL, + show_n = TRUE, + ncol = NULL +) { + comps <- prepare_comp_data(dat, comp_type = comp_type, fleet = fleet) + bin_label <- comp_bin_label(comps) + + if (aggregate) { + comps <- aggregate_comp_years(comps) + } + show_expected <- show_expected && any(!is.na(comps$expected)) + two_sex <- all(c("female", "male") %in% comps$sex) + + # Mirror males below zero for sex-specific comps + comps <- comps |> + dplyr::mutate( + direction = dplyr::if_else(two_sex & .data$sex == "male", -1, 1), + obs_plot = .data$observed * .data$direction, + exp_plot = .data$expected * .data$direction + ) + + bins <- sort(unique(comps$bin)) + width <- if (length(bins) > 1) min(diff(bins)) else 1 + + plt <- ggplot2::ggplot(comps, ggplot2::aes(x = .data$bin)) + if (length(unique(comps$sex)) > 1) { + plt <- plt + + ggplot2::geom_col( + ggplot2::aes(y = .data$obs_plot, fill = .data$sex), + width = width * 0.9, + alpha = 0.6, + position = if (two_sex) "identity" else "dodge" + ) + } else { + plt <- plt + + ggplot2::geom_col( + ggplot2::aes(y = .data$obs_plot), + width = width * 0.9, + alpha = 0.6, + fill = "gray50" + ) + } + if (show_expected) { + exp_dat <- dplyr::filter(comps, !is.na(.data$exp_plot)) + if (length(unique(comps$sex)) > 1) { + plt <- plt + + ggplot2::geom_line( + data = exp_dat, + ggplot2::aes(y = .data$exp_plot, group = .data$sex, color = .data$sex), + linewidth = 0.7 + ) + } else { + plt <- plt + + ggplot2::geom_line( + data = exp_dat, + ggplot2::aes(y = .data$exp_plot, group = .data$sex), + color = "#0085CA", + linewidth = 0.7 + ) + } + } + if (two_sex) { + plt <- plt + ggplot2::geom_hline(yintercept = 0, linewidth = 0.3) + } + + # Sample size labels + if (show_n && !aggregate && any(!is.na(comps$n))) { + n_lab <- comps |> + dplyr::filter(!is.na(.data$n)) |> + dplyr::distinct(.data$comp_type, .data$fleet, .data$year, .data$n) |> + dplyr::mutate(label = paste0("N=", round(.data$n, 1))) + plt <- plt + + ggplot2::geom_text( + data = n_lab, + ggplot2::aes(x = Inf, y = Inf, label = .data$label), + hjust = 1.1, + vjust = 1.5, + size = 2.8, + inherit.aes = FALSE + ) + } + + ylab <- if (two_sex) "Proportion (females above, males below)" else "Proportion" + plt <- plt + + ggplot2::scale_y_continuous(labels = function(x) abs(x)) + + ggplot2::labs( + x = bin_label, + y = ylab, + fill = if (length(unique(comps$sex)) > 1) "Sex", + color = if (length(unique(comps$sex)) > 1 && show_expected) "Sex" + ) + + theme_noaa() + + # Facets + facet_vars <- if (aggregate) "fleet" else c("fleet", "year") + if (!aggregate && length(unique(comps$fleet)) == 1) facet_vars <- "year" + if (length(unique(comps$comp_type)) > 1) facet_vars <- c("comp_type", facet_vars) + if (!aggregate && length(unique(comps$fleet)) > 1) { + cli::cli_alert_info( + "Plotting {length(unique(comps$fleet))} fleets by year; use {.arg fleet} to plot one fleet at a time." + ) + } + plt <- plt + comp_facet(facet_vars, ncol = ncol) + if (!aggregate) { + plt <- plt + ggplot2::theme( + strip.text = ggplot2::element_text(size = 9), + axis.text = ggplot2::element_text(size = 8) + ) + } + plt +} + +#------------------------------------------------------------------------------ + +#' Plot composition bubble plots +#' +#' Bubble plot of compositions by year (x-axis) and bin (y-axis). Bubbles can +#' show the observed (or expected) proportions, which makes strong and weak +#' cohorts easy to follow through time, or the Pearson residuals, which show +#' blocks or stripes of misfit among years or bins. +#' +#' @inheritParams plot_comp +#' @param value String. Value to plot. Options: "observed", "expected", or +#' "pearson". +#' +#' Default: "observed" +#' +#' @param max_size Number. Size of the largest bubble. +#' +#' Default: 6 +#' +#' @returns A `ggplot2` object. +#' +#' @details Panels are created for each fleet, and for each sex when +#' compositions are sex-specific. For Pearson residuals, filled bubbles are +#' positive residuals (observed > expected) and open bubbles are negative +#' residuals (observed < expected), with bubble area proportional to the +#' absolute value of the residual. The maximum absolute residual for each +#' panel is included in the panel label. +#' +#' @seealso [prepare_comp_data()], [plot_comp_residuals()], [plot_comp()] +#' @export +#' +#' @examples +#' # Observed proportions; strong year classes appear as diagonals +#' plot_comp_bubble(example_comp_data) +#' +#' # Pearson residuals +#' plot_comp_bubble(example_comp_data, value = "pearson") +plot_comp_bubble <- function( + dat, + value = c("observed", "pearson", "expected"), + comp_type = NULL, + fleet = NULL, + max_size = 6, + ncol = NULL +) { + value <- match.arg(value) + comps <- prepare_comp_data(dat, comp_type = comp_type, fleet = fleet) + bin_label <- comp_bin_label(comps) + comps$value <- comps[[value]] + comps <- dplyr::filter(comps, !is.na(.data$value)) + if (nrow(comps) == 0) { + if (value == "pearson") { + cli::cli_abort(c( + "No Pearson residuals available.", + "i" = "Supply a {.field pearson} column, or {.field expected} values and sample sizes ({.field n}) so residuals can be calculated." + )) + } + cli::cli_abort("No {value} values found in {.arg dat}.") + } + + facet_vars <- c( + if (length(unique(comps$comp_type)) > 1) "comp_type", + "fleet", + if (length(unique(comps$sex)) > 1) "sex" + ) + if (value == "pearson") { + # Add the max absolute residual to a single panel label, ordered by + # comp type, fleet, and sex + comps <- comps |> + dplyr::arrange(.data$comp_type, .data$fleet, .data$sex) |> + dplyr::group_by(dplyr::across(dplyr::all_of(facet_vars))) |> + dplyr::mutate( + panel = paste0( + paste(unlist(dplyr::cur_group()), collapse = ", "), + " (max = ", format(round(max(abs(.data$value)), 2), nsmall = 2), ")" + ) + ) |> + dplyr::ungroup() |> + dplyr::mutate(panel = factor(.data$panel, levels = unique(.data$panel))) |> + dplyr::mutate( + sign = factor( + dplyr::if_else(.data$value >= 0, "Observed > expected", "Observed < expected"), + levels = c("Observed > expected", "Observed < expected") + ) + ) + plt <- ggplot2::ggplot( + comps, + ggplot2::aes(x = .data$year, y = .data$bin, size = abs(.data$value), fill = .data$sign) + ) + + ggplot2::geom_point(shape = 21, color = "black", alpha = 0.8) + + ggplot2::scale_fill_manual( + values = c("Observed > expected" = "gray20", "Observed < expected" = "white"), + drop = FALSE + ) + + ggplot2::labs(size = "|Pearson residual|", fill = NULL) + + ggplot2::guides(fill = ggplot2::guide_legend(override.aes = list(size = 4))) + facet_vars <- "panel" + } else { + plt <- ggplot2::ggplot( + comps, + ggplot2::aes(x = .data$year, y = .data$bin, size = .data$value) + ) + + ggplot2::geom_point(shape = 21, color = "black", fill = "gray40", alpha = 0.5) + + ggplot2::labs(size = cap_first_letter(paste(value, "proportion"))) + } + + plt + + ggplot2::scale_size_area(max_size = max_size) + + ggplot2::scale_x_continuous( + breaks = axis_breaks(comps$year), + guide = ggplot2::guide_axis(minor.ticks = TRUE) + ) + + ggplot2::labs(x = "Year", y = bin_label) + + theme_noaa() + + comp_facet(facet_vars, ncol = ncol) +} + +#------------------------------------------------------------------------------ + +#' Plot composition Pearson residuals +#' +#' A convenience wrapper around [plot_comp_bubble()] with +#' `value = "pearson"`. Residuals are taken from `dat` when supplied or +#' calculated by [prepare_comp_data()] assuming a multinomial distribution. +#' +#' @inheritParams plot_comp_bubble +#' @param ... Additional arguments passed to [plot_comp_bubble()]. +#' +#' @returns A `ggplot2` object. +#' @seealso [plot_comp_bubble()], [prepare_comp_data()] +#' @export +#' +#' @examples +#' plot_comp_residuals(example_comp_data) +#' +#' # Compare residuals across fleets for one sex +#' plot_comp_residuals( +#' dplyr::filter(example_comp_data, sex == "female"), +#' ncol = 1 +#' ) +plot_comp_residuals <- function(dat, ...) { + plot_comp_bubble(dat, value = "pearson", ...) +} + +#------------------------------------------------------------------------------ + +#' Plot sex ratios implied by composition data +#' +#' Plot the proportion female, female / (female + male), by bin for the +#' observed and expected compositions. Trends in the lack of fit to sex ratios +#' can be easier to see here than in residuals, especially for bins with +#' small proportions. +#' +#' @inheritParams plot_comp +#' @param interval Number. Coverage of the interval around the observed sex +#' ratio, calculated as a Jeffreys interval using the sample size in each bin +#' (the sample size multiplied by the proportion of the composition in the +#' bin). Set to NULL to omit intervals. Intervals are only shown when sample +#' sizes are available. +#' +#' Default: 0.75 +#' +#' @returns A `ggplot2` object. +#' +#' @details Requires sex-specific compositions with both "female" and +#' "male" values in the `sex` column of `dat`. Points show observed ratios +#' and lines show expected ratios. When `aggregate = TRUE`, female and male +#' compositions are summed across years (weighted by sample size when +#' available) before calculating ratios. +#' +#' @seealso [prepare_comp_data()], [plot_comp()] +#' @export +#' +#' @examples +#' plot_comp_sex_ratio(example_comp_data, fleet = "Survey") +#' plot_comp_sex_ratio(example_comp_data, aggregate = TRUE) +plot_comp_sex_ratio <- function( + dat, + aggregate = FALSE, + interval = 0.75, + comp_type = NULL, + fleet = NULL, + ncol = NULL +) { + comps <- prepare_comp_data(dat, comp_type = comp_type, fleet = fleet) + bin_label <- comp_bin_label(comps) + if (!all(c("female", "male") %in% comps$sex)) { + cli::cli_abort("Sex ratios require compositions with both {.val female} and {.val male} values in the {.field sex} column.") + } + + # Females and males side by side, weighted by sample size when available + wide <- comps |> + dplyr::filter(.data$sex %in% c("female", "male")) |> + dplyr::mutate(w = dplyr::if_else(is.na(.data$n), 1, .data$n)) |> + dplyr::select("comp_type", "fleet", "year", "sex", "bin", "observed", "expected", "n", "w") |> + tidyr::pivot_wider(names_from = "sex", values_from = c("observed", "expected")) + group_vars <- if (aggregate) c("comp_type", "fleet", "bin") else c("comp_type", "fleet", "year", "bin") + + ratios <- wide |> + dplyr::group_by(dplyr::across(dplyr::all_of(group_vars))) |> + dplyr::summarise( + f_obs = sum(.data$observed_female * .data$w, na.rm = TRUE), + m_obs = sum(.data$observed_male * .data$w, na.rm = TRUE), + f_exp = sum(.data$expected_female * .data$w, na.rm = TRUE), + m_exp = sum(.data$expected_male * .data$w, na.rm = TRUE), + has_n = all(!is.na(.data$n)), + has_exp = any(!is.na(.data$expected_female)), + .groups = "drop" + ) |> + dplyr::mutate( + ratio_obs = .data$f_obs / (.data$f_obs + .data$m_obs), + ratio_exp = dplyr::if_else(.data$has_exp, .data$f_exp / (.data$f_exp + .data$m_exp), NA_real_), + # weighted sums equal the number of fish in the bin when w is the sample size + # (at least 1, as in r4ss) + n_bin = dplyr::if_else(.data$has_n, pmax(.data$f_obs + .data$m_obs, 1), NA_real_) + ) + ratios$ratio_obs[!is.finite(ratios$ratio_obs)] <- NA_real_ + ratios$ratio_exp[!is.finite(ratios$ratio_exp)] <- NA_real_ + + show_interval <- !is.null(interval) && any(!is.na(ratios$n_bin)) + if (show_interval) { + ci <- jeffreys_interval(ratios$ratio_obs, ratios$n_bin, level = interval) + ratios$lower <- ci$lower + ratios$upper <- ci$upper + } + + plt <- ggplot2::ggplot(ratios, ggplot2::aes(x = .data$bin)) + + ggplot2::geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray60") + + if (show_interval) { + plt <- plt + + ggplot2::geom_linerange( + data = dplyr::filter(ratios, !is.na(.data$ratio_obs), !is.na(.data$lower)), + ggplot2::aes(ymin = .data$lower, ymax = .data$upper), + color = "gray50" + ) + } + plt <- plt + + ggplot2::geom_point( + data = dplyr::filter(ratios, !is.na(.data$ratio_obs)), + ggplot2::aes(y = .data$ratio_obs, shape = "Observed"), + size = 1.5 + ) + if (any(!is.na(ratios$ratio_exp))) { + plt <- plt + + ggplot2::geom_line( + data = dplyr::filter(ratios, !is.na(.data$ratio_exp)), + ggplot2::aes(y = .data$ratio_exp, linetype = "Expected"), + color = "#0085CA", + linewidth = 0.8 + ) + } + + facet_vars <- if (aggregate) "fleet" else c("fleet", "year") + if (!aggregate && length(unique(ratios$fleet)) == 1) facet_vars <- "year" + if (length(unique(ratios$comp_type)) > 1) facet_vars <- c("comp_type", facet_vars) + + plt <- plt + + ggplot2::scale_y_continuous(limits = c(0, 1), breaks = c(0, 0.5, 1)) + + ggplot2::labs( + x = bin_label, + y = "Proportion female", + shape = NULL, + linetype = NULL, + caption = if (!is.null(interval) && any(!is.na(ratios$n_bin))) { + paste0("Vertical lines: ", round(interval * 100), "% Jeffreys intervals for observed ratios") + } + ) + + theme_noaa() + + comp_facet(facet_vars, ncol = ncol) + if (!aggregate) { + plt <- plt + ggplot2::theme( + strip.text = ggplot2::element_text(size = 9), + axis.text = ggplot2::element_text(size = 8) + ) + } + plt +} + +#------------------------------------------------------------------------------ + +#' Plot mean age or length of compositions over time +#' +#' Time series of the mean age or length in the observed and expected +#' compositions. Developed as a diagnostic for the Francis (2011) data +#' weighting method (TA1.8), the plot is also a useful summary of trends in +#' compositions and lack of fit among years. +#' +#' @inheritParams plot_comp +#' @param interval Number. Coverage of the interval around the observed mean. +#' +#' Default: 0.95 +#' +#' @param show_francis Logical. TRUE/FALSE; add the Francis TA1.8 weight for +#' each fleet to the panel label and show thinner, capped intervals +#' representing sample sizes after applying that weight. +#' +#' Default: TRUE +#' +#' @returns A `ggplot2` object. +#' +#' @details For each year and fleet (with sexes combined), the observed mean +#' is \eqn{\bar{x}_o = \sum_b x_b o_b} and the expected mean is +#' \eqn{\bar{x}_e = \sum_b x_b e_b}, where \eqn{x_b} is the bin and \eqn{o_b} +#' and \eqn{e_b} are the observed and expected proportions. Assuming a +#' multinomial distribution, the standard error of the mean is +#' \eqn{\sqrt{v_e / N}}, where \eqn{v_e = \sum_b x_b^2 e_b - \bar{x}_e^2} is +#' the variance of the expected composition and \eqn{N} is the sample size. +#' Intervals are drawn around the observed means. +#' +#' The Francis weight is \eqn{1 / \mathrm{var}(r)} where +#' \eqn{r = (\bar{x}_o - \bar{x}_e) / SE} are the standardized residuals of +#' the mean across years (fleets need at least three years). As in +#' `r4ss::SSMethod.TA1.8()`, its 95% interval is calculated by bootstrapping +#' the standardized residuals (1000 resamples), so use [set.seed()] for +#' reproducible intervals. The weight assumes a multinomial likelihood and has not been +#' adapted for Dirichlet-multinomial or other likelihoods. +#' +#' Without expected values, only the observed means are plotted. Without +#' sample sizes, no intervals or weights are shown. +#' +#' @references Francis, R.I.C.C. (2011). Data weighting in statistical +#' fisheries stock assessment models. Canadian Journal of Fisheries and +#' Aquatic Sciences 68: 1124-1138. +#' +#' @seealso [prepare_comp_data()], [plot_comp()] +#' @export +#' +#' @examples +#' plot_comp_mean(example_comp_data) +plot_comp_mean <- function( + dat, + interval = 0.95, + show_francis = TRUE, + comp_type = NULL, + fleet = NULL, + ncol = NULL +) { + comps <- prepare_comp_data(dat, comp_type = comp_type, fleet = fleet) + bin_label <- comp_bin_label(comps) + means <- comp_mean_table(comps) + z <- stats::qnorm(1 - (1 - interval) / 2) + has_exp <- any(!is.na(means$mean_exp)) + has_se <- any(!is.na(means$se)) + + # Francis weights by fleet + weights <- NULL + if (show_francis && has_exp && has_se) { + weights <- means |> + dplyr::filter(!is.na(.data$std_resid)) |> + dplyr::group_by(.data$comp_type, .data$fleet) |> + dplyr::filter(dplyr::n() > 2) |> + dplyr::summarise( + n_years = dplyr::n(), + weight = 1 / stats::var(.data$std_resid), + weight_lower = francis_boot_ci(.data$std_resid)[1], + weight_upper = francis_boot_ci(.data$std_resid)[2], + .groups = "drop" + ) |> + dplyr::mutate( + fleet_label = paste0( + .data$fleet, "\nFrancis weight = ", signif(.data$weight, 3), + " (", signif(.data$weight_lower, 3), "-", signif(.data$weight_upper, 3), ")" + ) + ) + means <- means |> + dplyr::left_join( + dplyr::select(weights, "comp_type", "fleet", "weight", "fleet_label"), + by = c("comp_type", "fleet") + ) |> + dplyr::mutate( + fleet = dplyr::if_else(is.na(.data$fleet_label), .data$fleet, .data$fleet_label), + se_adj = .data$se / sqrt(.data$weight) + ) + } + + plt <- ggplot2::ggplot(means, ggplot2::aes(x = .data$year)) + if (has_se) { + plt <- plt + + ggplot2::geom_linerange( + ggplot2::aes( + ymin = .data$mean_obs - z * .data$se, + ymax = .data$mean_obs + z * .data$se + ), + color = "gray40", + linewidth = 0.8 + ) + if (!is.null(weights) && nrow(weights) > 0) { + plt <- plt + + ggplot2::geom_errorbar( + ggplot2::aes( + ymin = .data$mean_obs - z * .data$se_adj, + ymax = .data$mean_obs + z * .data$se_adj + ), + color = "gray20", + linewidth = 0.3, + width = 0.4 + ) + } + } + plt <- plt + + ggplot2::geom_point(ggplot2::aes(y = .data$mean_obs, shape = "Observed"), size = 2) + if (has_exp) { + plt <- plt + + ggplot2::geom_line( + data = dplyr::filter(means, !is.na(.data$mean_exp)), + ggplot2::aes(y = .data$mean_exp, linetype = "Expected"), + color = "#0085CA", + linewidth = 0.8 + ) + } + + caption <- NULL + if (has_se) { + caption <- paste0(round(interval * 100), "% intervals based on input sample sizes") + if (!is.null(weights) && nrow(weights) > 0) { + caption <- paste0( + caption, + "; thinner capped intervals after Francis (2011) TA1.8 weighting" + ) + } + } + + facet_vars <- c(if (length(unique(means$comp_type)) > 1) "comp_type", "fleet") + plt + + ggplot2::scale_x_continuous( + breaks = axis_breaks(means$year), + guide = ggplot2::guide_axis(minor.ticks = TRUE) + ) + + ggplot2::labs( + x = "Year", + y = paste("Mean", tolower(bin_label)), + shape = NULL, + linetype = NULL, + caption = caption + ) + + theme_noaa() + + comp_facet(facet_vars, ncol = ncol, scales = "free_y") +} + +# Bootstrap 95% interval for the Francis weight, following +# r4ss::SSMethod.TA1.8() (1000 resamples of the standardized residuals) +francis_boot_ci <- function(std_resid, n_boot = 1000) { + boot <- matrix( + sample(std_resid, n_boot * length(std_resid), replace = TRUE), + nrow = length(std_resid) + ) + w <- apply(boot, 2, function(x) 1 / stats::var(x)) + as.vector(stats::quantile(w[is.finite(w)], c(0.025, 0.975), na.rm = TRUE)) +} + +# Mean bin of observed and expected compositions by year and fleet +comp_mean_table <- function(comps) { + comps |> + dplyr::group_by(.data$comp_type, .data$fleet, .data$year, .data$bin) |> + dplyr::summarise( + observed = sum(.data$observed, na.rm = TRUE), + expected = if (all(is.na(.data$expected))) NA_real_ else sum(.data$expected, na.rm = TRUE), + n = dplyr::first(.data$n), + .groups = "drop" + ) |> + dplyr::group_by(.data$comp_type, .data$fleet, .data$year) |> + dplyr::summarise( + mean_obs = sum(.data$bin * .data$observed) / sum(.data$observed), + mean_exp = sum(.data$bin * .data$expected) / sum(.data$expected), + # Use the expected distribution for the variance when available + var_bin = if (all(is.na(.data$expected))) { + sum(.data$bin^2 * .data$observed) / sum(.data$observed) - .data$mean_obs[1]^2 + } else { + sum(.data$bin^2 * .data$expected) / sum(.data$expected) - .data$mean_exp[1]^2 + }, + n = dplyr::first(.data$n), + .groups = "drop" + ) |> + dplyr::filter(is.finite(.data$mean_obs)) |> + dplyr::mutate( + se = sqrt(.data$var_bin / .data$n), + std_resid = (.data$mean_obs - .data$mean_exp) / .data$se + ) +} diff --git a/R/utils_comp.R b/R/utils_comp.R new file mode 100644 index 00000000..412cb802 --- /dev/null +++ b/R/utils_comp.R @@ -0,0 +1,427 @@ +#' Prepare composition data for plotting +#' +#' Reshape age or length composition data (observed and, optionally, +#' expected proportions) into the tidy format used by the composition +#' plotting functions ([plot_comp()], [plot_comp_bubble()], +#' [plot_comp_residuals()], [plot_comp_sex_ratio()], and [plot_comp_mean()]). +#' +#' @param dat A data frame of composition data. The following formats are +#' recognized automatically: +#' \describe{ +#' \item{Tidy composition data}{Columns `year`, `bin`, and `observed`, with +#' optional columns `fleet`, `sex`, `expected`, `n` (input or adjusted +#' sample size), `pearson`, and `comp_type`. See [example_comp_data].} +#' \item{FIMS output}{Output from FIMS (e.g., `FIMS::get_estimates()` or +#' [convert_output()] with `model = "fims"`) that contains `observed` and +#' `expected` columns. Rows whose `label` contains "comp" are kept and the +#' bin is taken from the `age` or `length` column.} +#' \item{stockplotr standard output}{Long-format output from +#' [convert_output()] where observed and expected compositions are stored in +#' the `estimate` column with labels such as +#' "age_composition_proportion"/"age_composition_observed" and +#' "age_composition_expected"/"age_composition_predicted" (and the +#' corresponding "length_" labels).} +#' \item{r4ss output}{A list returned by `r4ss::SS_output()` (length and +#' age compositions are combined and fleet names are added) or its +#' `lendbase` or `agedbase` elements (columns `Yr`, `Fleet`, `Sex`, `Bin`, +#' `Obs`, `Exp`, `Pearson`, `Nsamp_adj`, ...). Conditional +#' age-at-length rows are dropped from `agedbase` so that only marginal age +#' compositions remain.} +#' } +#' @param comp_type String. Type of composition to keep when `dat` contains +#' more than one. Options: "age", "length", or NULL (keep all). +#' +#' Default: NULL +#' +#' @param fleet Character or numeric vector. Fleet(s) to keep. NULL keeps all +#' fleets. +#' +#' Default: NULL +#' +#' @param normalize Logical. TRUE/FALSE; rescale observed and expected values +#' so that they sum to one within each year, fleet, and composition type +#' (summing across sexes so that sex-specific compositions remain jointly +#' normalized). Use TRUE when `dat` contains counts rather than proportions. +#' +#' Default: TRUE +#' +#' @returns A tibble with one row per year, fleet, sex, and bin and columns +#' `comp_type`, `fleet`, `year`, `sex`, `bin`, `observed`, `expected`, `n`, +#' and `pearson`. Columns that cannot be determined from `dat` are `NA`. +#' +#' @details When Pearson residuals are not supplied, they are calculated +#' assuming a multinomial distribution as +#' \deqn{r = (o - e) / \sqrt{e (1 - e) / N}} +#' where \eqn{o} and \eqn{e} are the observed and expected proportions and +#' \eqn{N} is the sample size in the `n` column. If `n` is not available, +#' residuals are left as `NA`. +#' +#' @seealso [plot_comp()], [plot_comp_bubble()], [plot_comp_residuals()], +#' [plot_comp_sex_ratio()], [plot_comp_mean()] +#' @export +#' +#' @examples +#' comps <- prepare_comp_data(example_comp_data, fleet = "Survey") +#' head(comps) +#' +#' # Data in the stockplotr long format are reshaped automatically +#' long <- data.frame( +#' label = rep(c("age_composition_proportion", "age_composition_expected"), each = 3), +#' year = 2020, +#' fleet = "fleet1", +#' age = rep(1:3, 2), +#' estimate = c(0.2, 0.5, 0.3, 0.25, 0.45, 0.3) +#' ) +#' prepare_comp_data(long) +prepare_comp_data <- function( + dat, + comp_type = NULL, + fleet = NULL, + normalize = TRUE +) { + # Full r4ss::SS_output() list: combine length and marginal age comps + if (!is.data.frame(dat) && is.list(dat) && + any(c("lendbase", "agedbase") %in% names(dat))) { + dbase <- dplyr::bind_rows(dat[["lendbase"]], dat[["agedbase"]]) + if (!is.null(dat[["FleetNames"]]) && nrow(dbase) > 0) { + dbase$Fleet_Name <- dat[["FleetNames"]][dbase$Fleet] + } + dat <- dbase + } + if (!is.data.frame(dat)) { + cli::cli_abort("{.arg dat} must be a data frame or an {.code r4ss::SS_output()} list.") + } + # Return early if the data are already prepared + if (inherits(dat, "stockplotr_comp")) { + out <- dat + } else { + out <- switch(detect_comp_format(dat), + "r4ss" = comp_from_r4ss(dat), + "obs_exp_cols" = comp_from_obs_exp_cols(dat), + "long" = comp_from_long(dat), + "tidy" = comp_from_tidy(dat), + cli::cli_abort(c( + "Could not find composition data in {.arg dat}.", + "i" = "Supply a data frame with columns {.field year}, {.field bin}, and {.field observed} (see {.code ?prepare_comp_data})." + )) + ) + } + + # Filter to comp type and fleet + if (!is.null(comp_type)) { + keep_type <- match.arg(comp_type, c("age", "length")) + out$comp_type[is.na(out$comp_type)] <- keep_type + out <- out[out$comp_type == keep_type, , drop = FALSE] + } else if (length(unique(stats::na.omit(out$comp_type))) > 1) { + cli::cli_alert_info( + "Both age and length compositions found; use {.arg comp_type} to plot one type at a time." + ) + } + if (!is.null(fleet)) { + out <- out[out$fleet %in% as.character(fleet), , drop = FALSE] + } + if (nrow(out) == 0) { + cli::cli_abort("No composition data remain after filtering by {.arg comp_type} and {.arg fleet}.") + } + + if (normalize && !inherits(dat, "stockplotr_comp")) { + out <- out |> + dplyr::group_by(.data$comp_type, .data$fleet, .data$year) |> + dplyr::mutate( + observed = .data$observed / sum(.data$observed, na.rm = TRUE), + expected = .data$expected / sum(.data$expected, na.rm = TRUE) + ) |> + dplyr::ungroup() |> + # 0/0 when a year has no observations + dplyr::mutate( + observed = dplyr::if_else(is.nan(.data$observed), NA_real_, .data$observed), + expected = dplyr::if_else(is.nan(.data$expected), NA_real_, .data$expected) + ) + } + + # Calculate multinomial Pearson residuals if not supplied + need_pearson <- is.na(out$pearson) & !is.na(out$expected) & !is.na(out$n) + if (any(need_pearson)) { + out$pearson[need_pearson] <- with( + out[need_pearson, ], + (observed - expected) / sqrt(expected * (1 - expected) / n) + ) + out$pearson[!is.finite(out$pearson)] <- NA_real_ + } + + out <- out |> + dplyr::arrange(.data$comp_type, .data$fleet, .data$year, .data$sex, .data$bin) + class(out) <- unique(c("stockplotr_comp", class(tibble::as_tibble(out)))) + out +} + +#------------------------------------------------------------------------------ +# Internal helpers for composition data +#------------------------------------------------------------------------------ + +# Columns returned by prepare_comp_data() +comp_cols <- c( + "comp_type", "fleet", "year", "sex", "bin", + "observed", "expected", "n", "pearson" +) + +# Find a column in dat ignoring case; returns NULL if absent +find_col <- function(dat, options) { + nm <- names(dat) + for (o in options) { + hit <- nm[tolower(nm) == tolower(o)] + if (length(hit) > 0) { + return(hit[1]) + } + } + NULL +} + +# Pull a column (by any of several names) or return a default vector +pull_col <- function(dat, options, default = NA) { + col <- find_col(dat, options) + if (is.null(col)) { + return(rep(default, nrow(dat))) + } + dat[[col]] +} + +detect_comp_format <- function(dat) { + if (!is.null(find_col(dat, "Yr")) && !is.null(find_col(dat, "Bin")) && + !is.null(find_col(dat, "Obs"))) { + return("r4ss") + } + has_obs <- !is.null(find_col(dat, "observed")) + has_bin <- !is.null(find_col(dat, c("bin", "age", "length", "length_bins"))) + if (has_obs && !is.null(find_col(dat, "label")) && + any(grepl("comp", dat[[find_col(dat, "label")]], ignore.case = TRUE)) && has_bin) { + return("obs_exp_cols") + } + if (!is.null(find_col(dat, "label")) && !is.null(find_col(dat, "estimate")) && + any(grepl("comp", dat[[find_col(dat, "label")]], ignore.case = TRUE) & + grepl("observed|proportion|expected|predicted", dat[[find_col(dat, "label")]], ignore.case = TRUE))) { + return("long") + } + if (has_obs && has_bin && !is.null(find_col(dat, "year"))) { + return("tidy") + } + "unknown" +} + +# Standardize sex codes to "female", "male", or "combined" +standardize_sex <- function(x) { + if (all(is.na(x))) { + return(rep("combined", length(x))) + } + x <- tolower(as.character(x)) + dplyr::case_when( + is.na(x) ~ "combined", + x %in% c("1", "f", "female", "females") ~ "female", + x %in% c("2", "m", "male", "males") ~ "male", + x %in% c("0", "3", "both", "combined", "unsexed", "u", "all") ~ "combined", + TRUE ~ x + ) +} + +comp_type_from_label <- function(label) { + dplyr::case_when( + grepl("len|size", label, ignore.case = TRUE) ~ "length", + grepl("age", label, ignore.case = TRUE) ~ "age", + TRUE ~ NA_character_ + ) +} + +finish_comp <- function(out) { + out <- tibble::as_tibble(out) + out$fleet <- as.character(out$fleet) + out$sex <- standardize_sex(out$sex) + for (col in c("year", "bin", "observed", "expected", "n", "pearson")) { + out[[col]] <- suppressWarnings(as.numeric(out[[col]])) + } + out$fleet[is.na(out$fleet)] <- "All" + out <- dplyr::filter(out, !is.na(.data$bin), !is.na(.data$year)) + out[, comp_cols] +} + +comp_from_tidy <- function(dat) { + finish_comp(data.frame( + comp_type = pull_col(dat, "comp_type", NA_character_), + fleet = pull_col(dat, c("fleet", "fleet_name"), "All"), + year = pull_col(dat, "year"), + sex = pull_col(dat, "sex"), + bin = pull_col(dat, c("bin", "age", "length", "length_bins")), + observed = pull_col(dat, "observed"), + expected = pull_col(dat, c("expected", "predicted")), + n = pull_col(dat, c("n", "sample_size", "nsamp", "nsamp_adj")), + pearson = pull_col(dat, c("pearson", "pearson_residual", "residual")) + )) +} + +comp_from_obs_exp_cols <- function(dat) { + label_col <- find_col(dat, "label") + dat <- dat[grepl("comp", dat[[label_col]], ignore.case = TRUE), , drop = FALSE] + type <- comp_type_from_label(dat[[label_col]]) + age <- pull_col(dat, "age") + len <- pull_col(dat, c("length", "length_bins")) + bin <- pull_col(dat, "bin") + bin <- dplyr::case_when( + !is.na(bin) ~ suppressWarnings(as.numeric(bin)), + type == "length" ~ suppressWarnings(as.numeric(len)), + TRUE ~ suppressWarnings(as.numeric(age)) + ) + finish_comp(data.frame( + comp_type = type, + fleet = pull_col(dat, c("fleet", "fleet_name", "module_id"), "All"), + year = pull_col(dat, c("year", "year_i")), + sex = pull_col(dat, "sex"), + bin = bin, + observed = pull_col(dat, "observed"), + expected = pull_col(dat, c("expected", "predicted")), + n = pull_col(dat, c("n", "sample_size", "nsamp", "nsamp_adj")), + pearson = pull_col(dat, c("pearson", "pearson_residual")) + )) +} + +comp_from_long <- function(dat) { + label_col <- find_col(dat, "label") + dat <- dat[grepl("comp", dat[[label_col]], ignore.case = TRUE), , drop = FALSE] + lab <- dat[[label_col]] + value_type <- dplyr::case_when( + grepl("expected|predicted", lab, ignore.case = TRUE) ~ "expected", + grepl("observed|proportion", lab, ignore.case = TRUE) ~ "observed", + TRUE ~ NA_character_ + ) + type <- comp_type_from_label(lab) + bin <- dplyr::if_else( + type == "length", + suppressWarnings(as.numeric(pull_col(dat, c("length_bins", "length", "bin")))), + suppressWarnings(as.numeric(pull_col(dat, c("age", "bin")))) + ) + long <- data.frame( + comp_type = type, + fleet = as.character(pull_col(dat, c("fleet", "fleet_name"), "All")), + year = suppressWarnings(as.numeric(pull_col(dat, "year"))), + sex = as.character(pull_col(dat, "sex")), + bin = bin, + value_type = value_type, + value = suppressWarnings(as.numeric(dat[[find_col(dat, "estimate")]])) + ) |> + dplyr::filter(!is.na(.data$value_type)) + wide <- long |> + tidyr::pivot_wider( + names_from = "value_type", + values_from = "value", + values_fn = function(x) sum(x, na.rm = TRUE) + ) + if (!"observed" %in% names(wide)) { + cli::cli_abort("No observed compositions found in {.arg dat}.") + } + if (!"expected" %in% names(wide)) wide$expected <- NA_real_ + wide$n <- NA_real_ + wide$pearson <- NA_real_ + finish_comp(wide) +} + +comp_from_r4ss <- function(dat) { + dat <- as.data.frame(dat) + # Drop conditional age-at-length data, keeping marginal age comps + lo <- find_col(dat, "Lbin_lo") + hi <- find_col(dat, "Lbin_hi") + kind <- pull_col(dat, "Kind") + if (!is.null(lo) && !is.null(hi)) { + is_age <- if (all(is.na(kind))) rep(TRUE, nrow(dat)) else toupper(kind) %in% "AGE" + range <- dat[[hi]] - dat[[lo]] + if (any(is_age) && length(unique(range[is_age])) > 1) { + cli::cli_alert_info("Conditional age-at-length data removed; only marginal age compositions are kept.") + keep <- !is_age | range == max(range[is_age], na.rm = TRUE) + dat <- dat[keep, , drop = FALSE] + kind <- kind[keep] + } + } + type <- dplyr::case_when( + toupper(kind) %in% c("LEN", "SIZE") ~ "length", + toupper(kind) == "AGE" ~ "age", + !is.null(lo) ~ "age", + TRUE ~ "length" + ) + fleet <- as.character(pull_col(dat, c("Fleet_Name", "Fleet_name", "Fleet"), "All")) + # Add partition to fleet name when a fleet has more than one partition + part <- pull_col(dat, "Part") + if (!all(is.na(part))) { + multi_part <- tapply(part, fleet, function(x) length(unique(x)) > 1) + part_name <- c("0" = "whole", "1" = "discard", "2" = "retained")[as.character(part)] + fleet <- ifelse(multi_part[fleet], paste0(fleet, " (", part_name, ")"), fleet) + } + finish_comp(data.frame( + comp_type = type, + fleet = fleet, + year = pull_col(dat, "Yr"), + sex = pull_col(dat, "Sex"), + bin = pull_col(dat, "Bin"), + observed = pull_col(dat, "Obs"), + expected = pull_col(dat, "Exp"), + # Dirichlet-multinomial sample size when available, as in r4ss + n = dplyr::coalesce( + suppressWarnings(as.numeric(pull_col(dat, "Nsamp_DM"))), + suppressWarnings(as.numeric(pull_col(dat, c("Nsamp_adj", "N")))) + ), + pearson = pull_col(dat, "Pearson") + )) +} + +# Axis label for the bin variable +comp_bin_label <- function(comps) { + types <- unique(stats::na.omit(comps$comp_type)) + if (length(types) == 1 && types == "age") { + "Age" + } else if (length(types) == 1 && types == "length") { + "Length" + } else { + "Bin" + } +} + +# Jeffreys interval for a binomial proportion +jeffreys_interval <- function(p, n, level = 0.75) { + alpha <- (1 - level) / 2 + x <- p * n + lower <- ifelse(x <= 0, 0, stats::qbeta(alpha, x + 0.5, n - x + 0.5)) + upper <- ifelse(x >= n, 1, stats::qbeta(1 - alpha, x + 0.5, n - x + 0.5)) + list(lower = lower, upper = upper) +} + +# Aggregate compositions across years within fleet (and sex). Years are +# weighted by sample size when available. +aggregate_comp_years <- function(comps) { + comps |> + dplyr::group_by(.data$comp_type, .data$fleet, .data$year) |> + dplyr::mutate(w = dplyr::if_else(is.na(.data$n), 1, .data$n)) |> + dplyr::group_by(.data$comp_type, .data$fleet, .data$sex, .data$bin) |> + dplyr::summarise( + observed = sum(.data$observed * .data$w, na.rm = TRUE), + expected = sum(.data$expected * .data$w, na.rm = TRUE), + has_exp = any(!is.na(.data$expected)), + .groups = "drop" + ) |> + dplyr::mutate(n = NA_real_) |> + dplyr::group_by(.data$comp_type, .data$fleet) |> + dplyr::mutate( + observed = .data$observed / sum(.data$observed), + expected = dplyr::if_else(.data$has_exp, .data$expected / sum(.data$expected), NA_real_) + ) |> + dplyr::ungroup() |> + dplyr::select(-"has_exp") +} + +# Facet a composition plot by the variables that vary in the data +comp_facet <- function(vars, ncol = NULL, scales = "fixed") { + if (length(vars) == 0) { + return(NULL) + } + ggplot2::facet_wrap( + ggplot2::vars(!!!rlang::syms(vars)), + ncol = ncol, + scales = scales, + labeller = ggplot2::labeller(.multi_line = FALSE) + ) +} diff --git a/data-raw/example_comp_data.R b/data-raw/example_comp_data.R new file mode 100644 index 00000000..054a8681 --- /dev/null +++ b/data-raw/example_comp_data.R @@ -0,0 +1,70 @@ +## Code to prepare `example_comp_data` +# Simulated sex-specific age compositions for a fishery and a survey. +# Expected values come from a simple age-structured operating model. The +# observed fishery data are generated with dome-shaped selectivity while the +# expected values assume asymptotic selectivity, which creates a pattern of +# misfit at older ages that the composition diagnostics should reveal. +set.seed(20261016) + +years <- 2001:2020 +ages <- 1:15 +n_years <- length(years) +n_ages <- length(ages) + +M <- c(female = 0.20, male = 0.28) +F_year <- 0.15 + 0.15 * sin(seq(0, pi, length.out = n_years)) +rec_dev <- stats::rnorm(n_years + n_ages, 0, 0.5) +# A few strong year classes to show up as diagonals in bubble plots +rec_dev[n_ages + which(years %in% c(2003, 2010, 2016)) - 1] <- c(1.3, 1.1, 1.2) + +logistic <- function(a, a50, slope) 1 / (1 + exp(-slope * (a - a50))) +sel_fishery_model <- logistic(ages, 5, 1.2) +sel_fishery_true <- sel_fishery_model * exp(-0.3 * pmax(ages - 7, 0)) +sel_survey <- logistic(ages, 2.5, 1.5) + +# Numbers at age by sex +N <- array(0, dim = c(n_years, n_ages, 2), dimnames = list(years, ages, names(M))) +for (s in 1:2) { + # Initial age structure + N[1, , s] <- 0.5 * exp(rec_dev[n_ages:1] - cumsum(c(0, rep(M[s] + 0.1, n_ages - 1)))) + for (y in 2:n_years) { + Z <- M[s] + F_year[y - 1] * sel_fishery_model + N[y, 1, s] <- 0.5 * exp(rec_dev[n_ages + y - 1]) + N[y, 2:n_ages, s] <- N[y - 1, 1:(n_ages - 1), s] * exp(-Z[1:(n_ages - 1)]) + N[y, n_ages, s] <- N[y, n_ages, s] + N[y - 1, n_ages, s] * exp(-Z[n_ages]) + } +} + +simulate_fleet <- function(fleet, yrs, sel_model, sel_true, n, theta) { + out <- list() + for (yr in yrs) { + y <- which(years == yr) + exp_model <- c(N[y, , "female"] * sel_model, N[y, , "male"] * sel_model) + exp_true <- c(N[y, , "female"] * sel_true, N[y, , "male"] * sel_true) + exp_model <- exp_model / sum(exp_model) + exp_true <- exp_true / sum(exp_true) + # Dirichlet-multinomial observation error + p <- stats::rgamma(length(exp_true), shape = theta * exp_true) + p <- p / sum(p) + obs <- as.vector(stats::rmultinom(1, n, p)) / n + out[[length(out) + 1]] <- data.frame( + comp_type = "age", + fleet = fleet, + year = yr, + sex = rep(c("female", "male"), each = n_ages), + bin = rep(ages, 2), + observed = obs, + expected = exp_model, + n = n + ) + } + do.call(rbind, out) +} + +example_comp_data <- rbind( + simulate_fleet("Fishery", years, sel_fishery_model, sel_fishery_true, n = 200, theta = 1000), + simulate_fleet("Survey", 2005:2020, sel_survey, sel_survey, n = 100, theta = 300) +) +example_comp_data <- tibble::as_tibble(example_comp_data) + +usethis::use_data(example_comp_data, overwrite = TRUE) diff --git a/data/example_comp_data.rda b/data/example_comp_data.rda new file mode 100644 index 0000000000000000000000000000000000000000..9d6e7bae15049f273390be9c0eb384860350381a GIT binary patch literal 9192 zcmVNgkT>vQ&2UKVgRpfklJ zl5LXH8q+8Uu*G34G-w_*aZvphLXQqy#XEllPy5zGw?Cp|25mUPtgFp+Z#|9eUyP1| zQ$1efE~BQOuo)u87W($Nff!BR43OWy-cLnj2vc8-ftH$uJtc8kujG_z+_%Ilol#*h zT;M+6iFq`xium!vE#__u6`Qk0L`1_m{wC3DQNiqdTUBaLx3%&d@*Zt3?&R4+SSuK$ zZS$sJQbl$W@S>-KQt!H}h(CiO>XY=XP%e;NjR~8mntY)=D}fJ%y+WQu_WdH<{pl!_ zb^(?4GG>FW)7b&r@z|nwlPd|$M81$g7i_rXJxhlxEn*dpxs$|WNdg(jzi@~&bE-ym z)*DdFn()>(qY0&CgsrH8Z+R_d@hWh@GsXWDY$nCNFc+o$arGZ`NGL|^_}jyAZp#j_ z>i=6u4yNePNixl+(AeMP!)NuVQqOAC+6K4572+Iirj~iq*(Ux>2Mvj=@fHK zJXwR#r40SqG?+@n_|33)_L5l>tM72JA75;FTiXWKrWxp4O!5ydQhA04`;@A#8?*?t z{S$0N8meS1vObo+$i;ARpinrCC>qk=S2=T%EF2IJpP%FauwrtN0V@A&K;Gmda&9$m zXtuSSFekaE1?D4wtA~@h*I0EW(b8Chzd_#jO#nNJHn@9>dyDNH;=|IH-7I!)f1*;2 z_dKhVVH7g2ZF+>KC3)Fd7RMKMJJS%6ZVLZ2R<>erG*FByLJEmtUj~Ml zb#MimveoBhhVA3PHMF$0q&f7;RFSm{LpPN}WXN!$A6}p@E~QLrCAI!~Df_m2Fz<^s ze7~af7$+~a!_{a-jL&h)s&q|VHUNl!`ox^bJ?U6XNt8_7YVR1|liN&L$*d0?Y0^8E zZtH-qKfazrEMzTaA0EgIrhRW=D-;5X)qd=28N=92xcGzF*0Fm*628ww1@mq9Yf2jA&iI&N$dVo4JW3J#nsRotB7F(i=hBeTiJ z$%uaZ0J0sF9fISyf=L@Ce9&wpKsm9Bh!eB|?xL1m7%IRWbl?zvY)o1rzpSN<}H%+iHjAA*Wqz8uYN3>lka&H#VEP6^)eMqW5Krf#n`8O)ol;Vkkj z20Ix=(5Cmx$PxM_)q-<9oh>)bxE20O^p$~#`O1>XOM5oOhUq(sJ^)@aJ}NRRt!^ug zDVkczsH%Bq7WgiHpMuqvD2v5>UO~~m2bDJEo9WkJ?MoQ6o(aRH114H*>Ep#S6HlE1 zAR5F(Z||foew&b@KVsJE>5m%nx-3=GbyIHU@~lUB9j^hIHg%->IjKZUx(8+aI&Nm_-+xP$A6VtgV^ZH9YN@u+QizvWxOo z7^6IkSjd{Dnp9TG?x1gN*)?CoIBi1)V{8r>T)j40wQ&eb--{5wDL-jRZeF~QQyoqO z9xo9n2oUsQ6n{jTd~u**Y!p*&p!=o>rB{){#wQ2II~>(4eA$KS`V8r8+kSZ6zt7oB zh(LY(e`oc97fe3|9S@ldiVT zIKuV`E;4J0UD+(^eRHXYjN8DKhaur5^D5!;Na=bveRJ?*ngYB;<npbOz>zm^zKG6OP1gEe&>cD9qu|pZ` zH?c|v8j9W)$Di(6rI{y4q8{AQqld)OA3MZ&GR$xI{L8b`0AND&xZ>qJOdEN5(oaupQ<|r{m-O?BXQ5h z<29qH8r~q_NQ-fimI}Zl^)*V+!{nA`qBJ)8yum7R}{HDGk?A+xL|AuyNw8S8P@x}V#aqCilhUeXPp6xbj)?rQ3-oQgA9in z7yU0HZF+h3({)Z9W&Vr)3^AvKJY7k-3KkY3;j*31KvQs>8nlbo6@R1^;Ve&c8|m#? zl*j*4c4AqsaOA*cL?itMiEs)j`3liD!1D!9&*3n_knjHItjRU+@SMu9J=tX%PnpH})RtRe# z_++k@jqZ%Cf`!rZsNm!PJKrGmE^CUwV(;t}b)B35$=HH%O+tuFX+F^zEZ}^xy7&E> zMqx3bpuM#PX+uxE0cjyrR$&|j$?bRqhV%PN3XR6mxsuuBMR#rVWWaLBV)J4T|ITT^ zf^g`(TX5ju9eB;0BO9vJFHZ^pmiUxrVLAecTHT7k@j@!9Bv&wfCrl9NfwRsFOg?U$ z13%Vjs9(Vj2^iSuV)LFRO44}_j)<)Y=s&~uyuw|i=Jkpzo^7oc z6D7i17mhM(cW7DF&u=kO$q#yKaCJFqor}`|?E&55tQ5vGv?Vb=`%y;)DAHerRrh5p zS$r;*Po#a6o_Cg(KaZU9cfy+B9wW5+5X?{2of~QZ`qxcJ1UMZ^q@3(gLUddJxYvmC zN!{T_(+o&rzPT5a^KE9LwdY?{)SmL)1hwG3JTcP!-{fwz~5XOqkqQ?kYvD&M= z79kImT%2+mrW1AYCT(HqR0m}PNU%I{5ZEfc!X>>k2#J#|X{i15$KsJ@|6pw}->ptx zlYLdNmL*zmdZJNl9_dw?*lmbO(ut-2EBhi{Qd6TWx7E@m-R?C#xK8afW)8QQVt3~h zUhElANPgvlpCg?^ieZL&$b_aMkd8SX1(HeC#UdX>6t^vm*=JKaUG^^@tM`WMh<+=% z=j(@jENEd%>u=ryCP5Gvx5zJ=M}-jIZe|vT1gQtuhXjSFI6N&Jozx+XgMr6aJ!gdo z4DAsQRGL#pAx>-vvq2ju6%$Nww$~mc>Vdg-!Ri@iN#Rrb`{+VAVB8tCQ#LvpQ5u=- zWYInpAd!Gj+C@EO(?*#WcxBjjXd}R1NQsZR7b0{l+1^*f!pQy}+{$6?WXXV z$5NYi4Hdh^F~`9Y7|mPBQ9#y8_eFQVf6`_fAiXwKtvl1HcUKIX5u#ba)tQIJC>|Gr zR0F!URz)~$xZ@}mu8~J>Yjin>Vi4X!@&BM&-bO=XID0&e>zSX&Km+7Dvc8m-OdL96 zP~GrLO+PWKfH`^F+PTx9a)4HY;0{^Q=b53Mib+O$D9<);j?szY1i9;r4==!a)s=l^ z-aE@|o#N2Ze?iVdJ?@sN)E**W&%PLx)iP+xGjQdh^l#naa}l1c{v0PMn@TeQjIi}9 z!NOF#SE+yM&p6F5H0RpaspI>gV+p^?9h>K1KGli~Nu#e}WrMUs@lOwy25$4Lz>0n~ zt56S~X9&kT@qnJV1~dH$#p`cd2D*I?Ou)T=fvLPa_Aa(Y^Ur3jX3H?XkQrlgmJ>J1 zXq&cVyA{rn@MRm@a47A(5H3#B5y3AeRgT4;E9S~tYnag6&AudVKP>xqV8qWxaB~^11VXr04`fEo;CXSzT|6FR3oTZZ|er`01Dn zivK#|I5Yj@B$c-MR8I8osjKIthGILo+JH8iDPSbpA|8*w1c_+MSpflkBjWYs#r8pv z(k93n+@OGV=3Nx7yj4Ebw>Xdj(@*~9zHn2N>vjy^R88D!(}Ts!IPZ<;)eT>hoX`D! z>=$OR4hY$eI}oh$mJJPqg`o!spGu17m;jr_Ti;jC|GFM_9G|0nWoFu~w8G|B$NG4-Bkk>4(DdOA6D!bQH| zK8%jTx^+p~UO@#j z_9WG7|3dqb=WGk(8qrTofU>8dj95~jUq!joUXQ=!9N_g<=mhT9ZPGRR1_lD43;M`# z;-qQUyQBF~YH+&Kc$4akcanKk-1l^#@J>Zb$5=fdI=E%3%d&_mQH3&MXw=iD|}GI2zwt9Joc(zuNX1&vw;;Oj}pRJ?8zWb6(X0weAYDgHMou$($vMqAMJ* z)>2OJJzWb%WRM8sJcMb}AbWZ_8Cd06sp$9216PDP4ZMC{`BTI!&A7Lye{SwvaBaN? zt!uRs#Zw@#JGYPlF&%fdTDQEQ-jh!Zo>(m*h+5TwzeGZ>lhH1uVXD?^Wsri(6-s{h z$m1i^;}NA-&xHN{Mf(T6gQ#tRJpBok=Ih<}j6Xa?w*BXip-`P&gWHVEem*RS`Ky*t zdMA<3J*y`iOV7l^!D954m}^^1bnRRO5g|4>G4k8MDe<`VFE<%@iGZvWyZ^)(<&FG8 zsC;mTh#S9|0G=MXj)C8^grbqeiwoQIs7c^j;n zV)Lrfl3I~@3t~wQF{vLUKKCh(TR*k^Uw8D0$|q|4PQKI7^PBY&LIMlr`UX)*W<6g~ zdzy+u1_Z%7r=Uc;)+Rt3JL?FZbDP|^k+S0r3VWTs*Bfm7TDkp;=M*@7(#p3-ccOKZDyHrV0*Wi78732#p<#8#{R8V4>BC%G{75dG znMu7O=>k8jazg<7jL>Fn$;A+fj~E*Mr@kYVT%(m2EqB^e#W3lO!lk z=+0?Y>{yb`Fs`x&qe&zz+j~!#M0D_o=5wIP^DN3hlJ;x|YeX!pxS41MaNV1)A3Fdr z6sz}%sWmrl)B|T!*e4XxG7nj42jWq##egcM!LSeiydhoZ)&6*7L+#|66o@J;+-z#0#i_6ejj^$rG5r)#cR?j4k79ceeD29F8lJGKO4XHYpn#AWp&d+J{~9u-u9 zSUBR8zZT#YTKf*iVbpz|3SZyg*OiP0GR2ml&gGAm@{t!Zx>z+p1Yw;iG5TL?!_@Mc z^Aye`&RBeB0jar;XOsq!s!KvE0J)sT2C*Fd5<;q~UkvVEGI63YCmH4SGCgwmM2KBi zUdx50PVAL9Kv-1aqj87DZq7^?#nzoQ*oyD?Bki=jpK>PfgB(>!?XsFAj!+_=r?9HC zxXe68z2Hm8XW=*C2e*@j`Z85;DLYD>nBx;DToeH!_l9a3P{0Fy&4=NoNlXd$*ioZDtsPiUj<2*4_N!)+ zq4zWB@qom=!MgC>*AsPH2$R3>5=$zN!GS3yj5A3*t;8hK5WWjsFVW!BeV!j($Oge`vx&~>Uy$#d)Pk9X?3k76klrK z5t3qy*L=hru<^f<=LlA&6c8Ohqho*5(rqRuSuSi3JGN#*Tc}#qSU%9hsuYj2cG8-{ zSlriH{ueur&Sr|M`vpFL<{ShGS&YjrZ~EpN9<{z4(rDKF_Ct6ioADNCXj1(a)~cD9+?h`g9aNXq@h)@WS1B41m@5S+7=)b$@jQGVh`8S zB8@@(z7|tOgV&N`faM}%hyCw-5a{UJV>XeH?QsC^bm-5yJ-YtKDo=*sjDu;V>JWYj z#4aGahWa0-n4c^ZB}OC7dDztgW^}p_x|YboBUY)o1s&6!GX9osILrwCtR@FUhzKj* zP4RezenB?HNN6xXGgSUpWjI_UD%MJr5Yo%g(^>nwMqa38KCr<{Tcpw+fo_JUbjB$vt7Vw04X#k8I=sSRFW5Q@EjJ8miy&N-Zuv zfCNL-Wrul33PeZi^7(-sd~vbIM_WwfFp*<IOkye~Khgo?CcE zRM)ARcla~{g|-2xqM@4sHwc`RcXN;VmtIw98IGl(o2N){>+Hht-G-{&Ee)HR+{41? z4mWOFTODWtJQ5JpuTB;E>msX2h+9brC3P#ay(E*!W?N8Azc*VStUFyzu)Q@J`YyzZ zD&?<$y9!V6`v{STe_(ZR*ZTMU102C%y$JEiD45d9z?;v@+3u}?_$;)y8p{NvxIT9_ z9~odl{&Tp9RO919I&vd*H!^$w?te{=gk;2Ti%^+{m=^+c-MDIMqKX1DK=zcVGqNu3 zNdpYyIbk5xod8|WuVJ1x3nVPLl_l*31OdEpn3E&)S}(5qo-lzY#Q z5SR7?u~&$k{nfFq_dNx%w$e%hyTn@xF!cUn6BvphcRPadGK~<>g1Tu87pqyTIazqT zP@EUTt{_W{1P?VaMbn4{@hD2?@d=S=^3RaIv&cNl!Ty3yamwr*F=fDql(viG(TM9& zL8{!5WwY7TkecAK+cTvlK{*H?y-CPFG56A*GZ4q zyH+JCXUR6O03g-aRToE@9MAn%k-ua@T%(;0EWt{-B|)C_oGx%kuDSmVl2zPfetb*e zN5}{kA%YqvEKFAVyI69G6`rzvwV jAD)lB0Kabj4{opjNTNIY|wd$lcj_;A)^_! zA5Z2dCU3kuL8vWBd;s~3qG$&!`FUn*jXw-dj=M02QPeAKEhu>oBI2Au10o+7uNID9 z`2%qT|F_EN|63?xI+Z8^Y_Q0cTX7$~{tT0^gWPNd6~&loc>N+a}(SkEN{D(@)GSib8tB z52<*tI~GWRJXRIH$X+=&$~D)aM)7wYM8Bs~4@)f)k;?!?<}wA*HjY2$AJ039%i#O& zRWjcC{Uk$Nl|9Oek?AYnU`OAtac=L0QzcdYE~J$d|NM? zyFH~`Ict;^vKyBHm~|9nJO=ekc!Of?*%zPRf?R{f{B|B+yUug{(VVIf@m$s%9jGqF zXwsb(JQI;>xInfV<(BgK{fw3`f@4W7Wv-7PgyY$s4qBx|BLLY^C5d@TIFCUZhgW6c z<6=JqSay~ENTZn02XLkm=XR;2+x}yZ6~NQTs`HfM<>Ppwb%Tz4qK8 zhOTV0^G|nc4dcS+w$-$7RdVua#c8R6y1{O}3m}7WSsN;)Z>pV}L8jvKFY<~NerD0U zPlW%2^?$)%RI%O2mtO>#ueJ1ypu1*+_&6EP&w`n}Etj?D3uzvjF~-cL4^6U1laChY z_?QU1b~*(O<{)(VcV}*Cs`)(xXF6mf5xtqP|KCW!s{;&@0okvG^|E181&9~R{qfgG zoi>=Ue-kOOh`5uD>I52ZAJNZczW%;b>=A;vBu|Ae{X35)50B0K1U;goQQ)GBbkprB%7q)&8Z_7Sr@k zV)&a&q9AMIVepG*kYyr^4j{KiDy?jnKpiT6XyR}~&!+_|##ZYC#*E%By{hz0b{+h8 z`KV+rr1hIH-LLwI_aqnAuXILvjJyC`D9d{8`$)x3+Ha!RS=Hu}Z+`kw91=L3rSS$^ zSvjZY;W8%Ed0V?#8g?YpEMkvl(EeQgr}}s*M=?SfUto{0S)Sv;JH*Q#!oYZJX{@T) zQs$WuxPcF)B{!v=%H{3@fRQad??L&RpZu|2Py<&jk`_~%X<`Nk zlOP2nl$SG5tBt1#r@2{R^>>ZQH2ua)_%HZrSJrz>H|h%u>e#AC<=o$OwZ~kilulB} z|FkSic9eq^0YJtHq>d9MhGM}4(#5FgIs1o({0+mpix1!E5yyZ1ahI@jC!t|DXhuK@ z7mB?3=#OtuJIovCs^Ky)XCh)ySq4nM;g^C#dMv*TTs~5l;cUA4r-vbzA7hxuX3on% z(PWpV4s1*&3kFF6>CS}gb{&Ss(5C`my#KQ{y22}P6EWlOcNHUb2a2p!nU+-bnX_jF zJL%YDRl{qlo!eU`6b3Ui<$Ck_%|t+R z0`1mM?i_xcx2!HsE|-Y+Wrk1|mln??9frtQlfu~qiEN78w7zc%m@RPj{=QpyZP>N9 z4^Hdt)s~~e6%LUkeAf9iQ;2I0sMMZ|gcmCImrfwQQx_rQ#976v)wWTMI`+H%95xem z;*?_^Kh7%+$uK{al!O>=fVAu};-sZU+}=#tH~G}>AzlcD62nFZ002A|UY1YVfmOCB zMx)7JooHyEf%ln=0dKKvnu5s6@7L&mO`!i;?e0UBTbBAw$r4^+UAn*hrtFAcY`6H_ zTGjFdn|6^Ar_O`&`ODy+zJ6 zW`aIb^eZ2s4pDJY;@fe8(%PG5*C+p1PWw8_MuFouEm{N>t;#pYWE#t+JdO;vq#*{} zuGEx^qnhoX5|p3Kgx4~){9H#osgxh&G_j=4XntVuUEh|EUMMXaQ^U%nW)miRgoqK! zd8%IbD_aVBvj|W1S;~f(#ZwF+ZB&W0F25)B#WC_N6{BNFH;slDZb4DeF@vC z&j7@!LGt$q@^YOXZ%{2~EdOd=Itppl1sHgGxW2B*C3UGT@y3lHx281`iJx-$ShS9m zT8{I9Zo7qrA>E@?!L>{ce&ho=Zf*NUI-1drHObbhW3PcisWze*VFlzq4uHLPnTpb( yzL expected) and open bubbles are negative +residuals (observed < expected), with bubble area proportional to the +absolute value of the residual. The maximum absolute residual for each +panel is included in the panel label. +} +\examples{ +# Observed proportions; strong year classes appear as diagonals +plot_comp_bubble(example_comp_data) + +# Pearson residuals +plot_comp_bubble(example_comp_data, value = "pearson") +} +\seealso{ +[prepare_comp_data()], [plot_comp_residuals()], [plot_comp()] +} diff --git a/man/plot_comp_mean.Rd b/man/plot_comp_mean.Rd new file mode 100644 index 00000000..4ad2c879 --- /dev/null +++ b/man/plot_comp_mean.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_comp.R +\name{plot_comp_mean} +\alias{plot_comp_mean} +\title{Plot mean age or length of compositions over time} +\usage{ +plot_comp_mean( + dat, + interval = 0.95, + show_francis = TRUE, + comp_type = NULL, + fleet = NULL, + ncol = NULL +) +} +\arguments{ +\item{dat}{A data frame of composition data in any format accepted by +[prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` +table, or a tidy data frame like [example_comp_data].} + +\item{interval}{Number. Coverage of the interval around the observed mean. + +Default: 0.95} + +\item{show_francis}{Logical. TRUE/FALSE; add the Francis TA1.8 weight for +each fleet to the panel label and show thinner, capped intervals +representing sample sizes after applying that weight. + +Default: TRUE} + +\item{comp_type}{String. Type of composition to keep when `dat` contains +more than one. Options: "age", "length", or NULL (keep all). + +Default: NULL} + +\item{fleet}{Character or numeric vector. Fleet(s) to keep. NULL keeps all +fleets. + +Default: NULL} + +\item{ncol}{Number. Number of facet columns. NULL lets `ggplot2` choose. + +Default: NULL} +} +\value{ +A `ggplot2` object. +} +\description{ +Time series of the mean age or length in the observed and expected +compositions. Developed as a diagnostic for the Francis (2011) data +weighting method (TA1.8), the plot is also a useful summary of trends in +compositions and lack of fit among years. +} +\details{ +For each year and fleet (with sexes combined), the observed mean +is \eqn{\bar{x}_o = \sum_b x_b o_b} and the expected mean is +\eqn{\bar{x}_e = \sum_b x_b e_b}, where \eqn{x_b} is the bin and \eqn{o_b} +and \eqn{e_b} are the observed and expected proportions. Assuming a +multinomial distribution, the standard error of the mean is +\eqn{\sqrt{v_e / N}}, where \eqn{v_e = \sum_b x_b^2 e_b - \bar{x}_e^2} is +the variance of the expected composition and \eqn{N} is the sample size. +Intervals are drawn around the observed means. + +The Francis weight is \eqn{1 / \mathrm{var}(r)} where +\eqn{r = (\bar{x}_o - \bar{x}_e) / SE} are the standardized residuals of +the mean across years (fleets need at least three years). As in +`r4ss::SSMethod.TA1.8()`, its 95% interval is calculated by bootstrapping +the standardized residuals (1000 resamples), so use [set.seed()] for +reproducible intervals. The weight assumes a multinomial likelihood and has not been +adapted for Dirichlet-multinomial or other likelihoods. + +Without expected values, only the observed means are plotted. Without +sample sizes, no intervals or weights are shown. +} +\examples{ +plot_comp_mean(example_comp_data) +} +\references{ +Francis, R.I.C.C. (2011). Data weighting in statistical +fisheries stock assessment models. Canadian Journal of Fisheries and +Aquatic Sciences 68: 1124-1138. +} +\seealso{ +[prepare_comp_data()], [plot_comp()] +} diff --git a/man/plot_comp_residuals.Rd b/man/plot_comp_residuals.Rd new file mode 100644 index 00000000..e8484303 --- /dev/null +++ b/man/plot_comp_residuals.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_comp.R +\name{plot_comp_residuals} +\alias{plot_comp_residuals} +\title{Plot composition Pearson residuals} +\usage{ +plot_comp_residuals(dat, ...) +} +\arguments{ +\item{dat}{A data frame of composition data in any format accepted by +[prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` +table, or a tidy data frame like [example_comp_data].} + +\item{...}{Additional arguments passed to [plot_comp_bubble()].} +} +\value{ +A `ggplot2` object. +} +\description{ +A convenience wrapper around [plot_comp_bubble()] with +`value = "pearson"`. Residuals are taken from `dat` when supplied or +calculated by [prepare_comp_data()] assuming a multinomial distribution. +} +\examples{ +plot_comp_residuals(example_comp_data) + +# Compare residuals across fleets for one sex +plot_comp_residuals( + dplyr::filter(example_comp_data, sex == "female"), + ncol = 1 +) +} +\seealso{ +[plot_comp_bubble()], [prepare_comp_data()] +} diff --git a/man/plot_comp_sex_ratio.Rd b/man/plot_comp_sex_ratio.Rd new file mode 100644 index 00000000..4f806fe0 --- /dev/null +++ b/man/plot_comp_sex_ratio.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_comp.R +\name{plot_comp_sex_ratio} +\alias{plot_comp_sex_ratio} +\title{Plot sex ratios implied by composition data} +\usage{ +plot_comp_sex_ratio( + dat, + aggregate = FALSE, + interval = 0.75, + comp_type = NULL, + fleet = NULL, + ncol = NULL +) +} +\arguments{ +\item{dat}{A data frame of composition data in any format accepted by +[prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` +table, or a tidy data frame like [example_comp_data].} + +\item{aggregate}{Logical. TRUE/FALSE; aggregate compositions across years +within each fleet. Years are weighted by their sample size when sample +sizes are available. + +Default: FALSE} + +\item{interval}{Number. Coverage of the interval around the observed sex +ratio, calculated as a Jeffreys interval using the sample size in each bin +(the sample size multiplied by the proportion of the composition in the +bin). Set to NULL to omit intervals. Intervals are only shown when sample +sizes are available. + +Default: 0.75} + +\item{comp_type}{String. Type of composition to keep when `dat` contains +more than one. Options: "age", "length", or NULL (keep all). + +Default: NULL} + +\item{fleet}{Character or numeric vector. Fleet(s) to keep. NULL keeps all +fleets. + +Default: NULL} + +\item{ncol}{Number. Number of facet columns. NULL lets `ggplot2` choose. + +Default: NULL} +} +\value{ +A `ggplot2` object. +} +\description{ +Plot the proportion female, female / (female + male), by bin for the +observed and expected compositions. Trends in the lack of fit to sex ratios +can be easier to see here than in residuals, especially for bins with +small proportions. +} +\details{ +Requires sex-specific compositions with both "female" and +"male" values in the `sex` column of `dat`. Points show observed ratios +and lines show expected ratios. When `aggregate = TRUE`, female and male +compositions are summed across years (weighted by sample size when +available) before calculating ratios. +} +\examples{ +plot_comp_sex_ratio(example_comp_data, fleet = "Survey") +plot_comp_sex_ratio(example_comp_data, aggregate = TRUE) +} +\seealso{ +[prepare_comp_data()], [plot_comp()] +} diff --git a/man/prepare_comp_data.Rd b/man/prepare_comp_data.Rd new file mode 100644 index 00000000..ce69888c --- /dev/null +++ b/man/prepare_comp_data.Rd @@ -0,0 +1,87 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils_comp.R +\name{prepare_comp_data} +\alias{prepare_comp_data} +\title{Prepare composition data for plotting} +\usage{ +prepare_comp_data(dat, comp_type = NULL, fleet = NULL, normalize = TRUE) +} +\arguments{ +\item{dat}{A data frame of composition data. The following formats are +recognized automatically: +\describe{ + \item{Tidy composition data}{Columns `year`, `bin`, and `observed`, with + optional columns `fleet`, `sex`, `expected`, `n` (input or adjusted + sample size), `pearson`, and `comp_type`. See [example_comp_data].} + \item{FIMS output}{Output from FIMS (e.g., `FIMS::get_estimates()` or + [convert_output()] with `model = "fims"`) that contains `observed` and + `expected` columns. Rows whose `label` contains "comp" are kept and the + bin is taken from the `age` or `length` column.} + \item{stockplotr standard output}{Long-format output from + [convert_output()] where observed and expected compositions are stored in + the `estimate` column with labels such as + "age_composition_proportion"/"age_composition_observed" and + "age_composition_expected"/"age_composition_predicted" (and the + corresponding "length_" labels).} + \item{r4ss output}{A list returned by `r4ss::SS_output()` (length and + age compositions are combined and fleet names are added) or its + `lendbase` or `agedbase` elements (columns `Yr`, `Fleet`, `Sex`, `Bin`, + `Obs`, `Exp`, `Pearson`, `Nsamp_adj`, ...). Conditional + age-at-length rows are dropped from `agedbase` so that only marginal age + compositions remain.} +}} + +\item{comp_type}{String. Type of composition to keep when `dat` contains +more than one. Options: "age", "length", or NULL (keep all). + +Default: NULL} + +\item{fleet}{Character or numeric vector. Fleet(s) to keep. NULL keeps all +fleets. + +Default: NULL} + +\item{normalize}{Logical. TRUE/FALSE; rescale observed and expected values +so that they sum to one within each year, fleet, and composition type +(summing across sexes so that sex-specific compositions remain jointly +normalized). Use TRUE when `dat` contains counts rather than proportions. + +Default: TRUE} +} +\value{ +A tibble with one row per year, fleet, sex, and bin and columns +`comp_type`, `fleet`, `year`, `sex`, `bin`, `observed`, `expected`, `n`, +and `pearson`. Columns that cannot be determined from `dat` are `NA`. +} +\description{ +Reshape age or length composition data (observed and, optionally, +expected proportions) into the tidy format used by the composition +plotting functions ([plot_comp()], [plot_comp_bubble()], +[plot_comp_residuals()], [plot_comp_sex_ratio()], and [plot_comp_mean()]). +} +\details{ +When Pearson residuals are not supplied, they are calculated +assuming a multinomial distribution as +\deqn{r = (o - e) / \sqrt{e (1 - e) / N}} +where \eqn{o} and \eqn{e} are the observed and expected proportions and +\eqn{N} is the sample size in the `n` column. If `n` is not available, +residuals are left as `NA`. +} +\examples{ +comps <- prepare_comp_data(example_comp_data, fleet = "Survey") +head(comps) + +# Data in the stockplotr long format are reshaped automatically +long <- data.frame( + label = rep(c("age_composition_proportion", "age_composition_expected"), each = 3), + year = 2020, + fleet = "fleet1", + age = rep(1:3, 2), + estimate = c(0.2, 0.5, 0.3, 0.25, 0.45, 0.3) +) +prepare_comp_data(long) +} +\seealso{ +[plot_comp()], [plot_comp_bubble()], [plot_comp_residuals()], +[plot_comp_sex_ratio()], [plot_comp_mean()] +} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index d8eb1642..70850b6a 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -27,6 +27,8 @@ navbar: href: articles/how-caps-alttext-are-made.html - text: Standardizing Assessment Model Output href: articles/convert_output_details.html + - text: Composition data diagnostics + href: articles/composition_diagnostics.html cheatsheet: text: Cheatsheet diff --git a/tests/testthat/test-plot_comp.R b/tests/testthat/test-plot_comp.R new file mode 100644 index 00000000..5e88cb3b --- /dev/null +++ b/tests/testthat/test-plot_comp.R @@ -0,0 +1,181 @@ +r4ss_output <- readRDS( + test_path("fixtures", "r4ss_output", "simple_small", "simple_r4ss.rds") +) + +has_layer <- function(p, geom_class) { + any(vapply(p$layers, function(l) inherits(l$geom, geom_class), logical(1))) +} + +# prepare_comp_data ---------------------------------------------------------- +test_that("prepare_comp_data returns standard columns from tidy data", { + comps <- prepare_comp_data(stockplotr::example_comp_data) + expect_s3_class(comps, "stockplotr_comp") + expect_named( + comps, + c("comp_type", "fleet", "year", "sex", "bin", "observed", "expected", "n", "pearson") + ) + # proportions sum to one across sexes within year and fleet + sums <- comps |> + dplyr::summarise(total = sum(observed), .by = c(fleet, year)) + expect_true(all(abs(sums$total - 1) < 1e-8)) + # multinomial Pearson residuals are calculated + i <- 10 + expect_equal( + comps$pearson[i], + (comps$observed[i] - comps$expected[i]) / + sqrt(comps$expected[i] * (1 - comps$expected[i]) / comps$n[i]) + ) +}) + +test_that("prepare_comp_data filters by fleet and comp_type", { + comps <- prepare_comp_data(stockplotr::example_comp_data, fleet = "Survey") + expect_equal(unique(comps$fleet), "Survey") + expect_error( + prepare_comp_data(stockplotr::example_comp_data, fleet = "not a fleet"), + "No composition data" + ) + expect_error( + prepare_comp_data(stockplotr::example_comp_data, comp_type = "length"), + "No composition data" + ) +}) + +test_that("prepare_comp_data normalizes counts", { + counts <- data.frame(year = 2000, bin = 1:4, observed = c(10, 20, 30, 40)) + comps <- prepare_comp_data(counts) + expect_equal(comps$observed, c(0.1, 0.2, 0.3, 0.4)) + expect_equal(unique(comps$sex), "combined") + expect_true(all(is.na(comps$expected))) +}) + +test_that("prepare_comp_data reshapes stockplotr long format", { + long <- data.frame( + label = rep(c("age_composition_proportion", "age_composition_expected"), each = 3), + year = 2020, + fleet = "fleet1", + age = rep(1:3, 2), + estimate = c(0.2, 0.5, 0.3, 0.25, 0.45, 0.3) + ) + comps <- prepare_comp_data(long) + expect_equal(nrow(comps), 3) + expect_equal(comps$observed, c(0.2, 0.5, 0.3)) + expect_equal(comps$expected, c(0.25, 0.45, 0.3)) + expect_equal(unique(comps$comp_type), "age") +}) + +test_that("prepare_comp_data reads FIMS-style observed/expected columns", { + fims <- data.frame( + module_name = "Fleet", + label = rep(c("agecomp_expected", "lengthcomp_expected"), each = 4), + fleet = "survey1", + year = 1, + age = c(1:4, rep(NA, 4)), + length = c(rep(NA, 4), seq(10, 40, by = 10)), + observed = c(1, 2, 3, 4, 4, 3, 2, 1), + expected = c(1.5, 2, 3, 3.5, 4, 3, 2, 1) + ) + comps <- prepare_comp_data(fims) + expect_setequal(comps$comp_type, c("age", "length")) + len <- prepare_comp_data(fims, comp_type = "length") + expect_equal(len$bin, c(10, 20, 30, 40)) + expect_equal(sum(len$observed), 1) +}) + +test_that("prepare_comp_data reads r4ss output", { + comps <- prepare_comp_data(r4ss_output) + expect_setequal(comps$comp_type, c("age", "length")) + expect_true("FISHERY" %in% comps$fleet) + expect_setequal(unique(comps$sex), c("female", "male")) + # r4ss Pearson residuals are kept rather than recalculated + len <- prepare_comp_data(r4ss_output$lendbase) + expect_equal( + sort(len$pearson), + sort(as.numeric(r4ss_output$lendbase$Pearson)) + ) +}) + +# plot_comp ------------------------------------------------------------------ +test_that("plot_comp makes observation-only and fit plots", { + p_obs <- plot_comp(stockplotr::example_comp_data, fleet = "Survey", show_expected = FALSE) + expect_s3_class(p_obs, "ggplot") + expect_true(has_layer(p_obs, "GeomCol")) + expect_false(has_layer(p_obs, "GeomLine")) + + p_fit <- plot_comp(stockplotr::example_comp_data, fleet = "Fishery") + expect_true(has_layer(p_fit, "GeomLine")) + # males are mirrored below zero + expect_true(any(p_fit$data$obs_plot < 0)) +}) + +test_that("plot_comp aggregates across years", { + p <- plot_comp(stockplotr::example_comp_data, aggregate = TRUE) + expect_s3_class(p, "ggplot") + expect_false("year" %in% names(p$data)) + sums <- p$data |> + dplyr::summarise(total = sum(observed), .by = fleet) + expect_true(all(abs(sums$total - 1) < 1e-8)) +}) + +test_that("plot_comp works with r4ss output", { + expect_no_error(plot_comp(r4ss_output, comp_type = "length", fleet = "FISHERY")) +}) + +# plot_comp_bubble / plot_comp_residuals -------------------------------------- +test_that("bubble plots show observations and residuals", { + p <- plot_comp_bubble(stockplotr::example_comp_data) + expect_s3_class(p, "ggplot") + expect_true(has_layer(p, "GeomPoint")) + + r <- plot_comp_residuals(stockplotr::example_comp_data) + expect_s3_class(r, "ggplot") + expect_true(all(c("Observed > expected", "Observed < expected") %in% levels(r$data$sign))) + expect_true(any(grepl("max =", r$data$panel))) +}) + +test_that("residual plot errors without expected values or sample sizes", { + obs_only <- dplyr::select(stockplotr::example_comp_data, -expected, -n) + expect_error(plot_comp_residuals(obs_only), "No Pearson residuals") +}) + +# plot_comp_sex_ratio --------------------------------------------------------- +test_that("plot_comp_sex_ratio calculates ratios and intervals", { + p <- plot_comp_sex_ratio(stockplotr::example_comp_data, fleet = "Survey") + expect_s3_class(p, "ggplot") + expect_true(has_layer(p, "GeomLinerange")) + ratios <- p$data + ok <- !is.na(ratios$ratio_obs) + expect_true(all(ratios$ratio_obs[ok] >= 0 & ratios$ratio_obs[ok] <= 1)) + expect_true(all(ratios$lower[ok] <= ratios$ratio_obs[ok] + 1e-12)) + expect_true(all(ratios$upper[ok] >= ratios$ratio_obs[ok] - 1e-12)) + + expect_no_error(plot_comp_sex_ratio(stockplotr::example_comp_data, aggregate = TRUE)) +}) + +test_that("plot_comp_sex_ratio requires two sexes", { + combined <- dplyr::filter(stockplotr::example_comp_data, sex == "female") + expect_error(plot_comp_sex_ratio(combined), "both") +}) + +# plot_comp_mean -------------------------------------------------------------- +test_that("plot_comp_mean matches r4ss Francis weights", { + # Values from r4ss::SSMethod.TA1.8() for the simple_small model + means <- comp_mean_table( + prepare_comp_data(r4ss_output, comp_type = "length", fleet = "FISHERY") + ) + expect_equal(1 / stats::var(means$std_resid), 1.3108142, tolerance = 1e-6) + means <- comp_mean_table( + prepare_comp_data(r4ss_output, comp_type = "age", fleet = "SURVEY1") + ) + expect_equal(1 / stats::var(means$std_resid), 2.667424, tolerance = 1e-6) +}) + +test_that("plot_comp_mean plots observed and expected means", { + p <- plot_comp_mean(stockplotr::example_comp_data) + expect_s3_class(p, "ggplot") + expect_true(has_layer(p, "GeomLine")) + expect_true(has_layer(p, "GeomErrorbar")) + expect_true(any(grepl("Francis weight", p$data$fleet))) + + no_francis <- plot_comp_mean(stockplotr::example_comp_data, show_francis = FALSE) + expect_false(has_layer(no_francis, "GeomErrorbar")) +}) diff --git a/vignettes/composition_diagnostics.Rmd b/vignettes/composition_diagnostics.Rmd new file mode 100644 index 00000000..41f54757 --- /dev/null +++ b/vignettes/composition_diagnostics.Rmd @@ -0,0 +1,177 @@ +--- +title: "Composition data diagnostics" +output: + html_document: + toc: true +vignette: > + %\VignetteIndexEntry{Composition data diagnostics} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + fig.width = 9, + fig.height = 7, + out.width = "100%" +) +``` + +```{r setup} +library(stockplotr) +``` + +Age and length compositions are often the most informative, and the hardest +to fit, data in a stock assessment. {stockplotr} has a set of plots for +composition data based on the figures that +[r4ss](https://github.com/r4ss/r4ss) makes for Stock Synthesis models. Each +type of plot shows the data in a different way: + +| Plot | Function | What it shows | +|------|----------|---------------| +| Distributions of observations | `plot_comp(show_expected = FALSE)` | The most intuitive way to look at compositions | +| Bubble plot of observations | `plot_comp_bubble()` | Cohort strength over time | +| Distributions of observed and expected values | `plot_comp()` | An intuitive way to look at fit | +| Pearson residuals | `plot_comp_residuals()` | Blocks or stripes of misfit among years or bins | +| Sex ratios | `plot_comp_sex_ratio()` | Trends in misfit for bins with small proportions, which have small residuals | +| Mean age or length | `plot_comp_mean()` | Trends among years; Francis (2011) data weights | + +Each function can plot each fleet separately or summarize all fleets. Use +`fleet` to choose fleets, and `aggregate = TRUE` in `plot_comp()` and +`plot_comp_sex_ratio()` to combine all years. + +## Composition data + +The plotting functions take composition data in one of several formats and +standardize it with `prepare_comp_data()`: + +* A tidy data frame with columns `year`, `bin`, and `observed`, and, + optionally, `fleet`, `sex`, `expected`, `n` (sample size), `pearson`, and + `comp_type` ("age" or "length"). +* FIMS output with `observed` and `expected` columns, such as the output of + `FIMS::get_estimates()`. +* {stockplotr} standard output from `convert_output()` with labels such as + `age_composition_proportion` and `age_composition_expected`. +* Output from `r4ss::SS_output()`, either the whole list or its `lendbase` or + `agedbase` data frames. + +This vignette uses `example_comp_data`, which holds simulated sex-specific age +compositions for a fishery and a survey. The observed fishery data were +simulated with dome-shaped selectivity, but the expected values assume +asymptotic selectivity. The diagnostics below should show that misfit. + +```{r} +head(example_comp_data) +``` + +If Pearson residuals are not supplied, `prepare_comp_data()` calculates them +assuming a multinomial distribution, +$r = (o - e) / \sqrt{e (1 - e) / N}$, using the sample size `n`. + +## Observations + +Distributions are the most intuitive way to look at compositions. For +sex-specific data, females are shown above zero and males below. + +```{r obs-dist} +plot_comp(example_comp_data, fleet = "Survey", show_expected = FALSE) +``` + +Bubble plots make it easier to see strong and weak year classes moving +through the population as diagonal lines. + +```{r obs-bubble} +plot_comp_bubble(example_comp_data) +``` + +## Fits to the data + +Adding the expected values to the distribution plot shows the fit to each +year. + +```{r fit-dist} +plot_comp(example_comp_data, fleet = "Fishery") +``` + +Aggregating across years gives an overview of each fleet. Years are weighted +by their sample sizes. + +```{r fit-agg, fig.height = 4} +plot_comp(example_comp_data, aggregate = TRUE) +``` + +### Pearson residuals + +Pearson residuals are a more statistically rigorous way to look at fit. +Filled bubbles show where more fish were observed than expected, and open +bubbles where fewer were observed. Here, the fishery has consistently +negative residuals at older ages, which is the pattern caused by the +mis-specified selectivity. + +```{r resid} +plot_comp_residuals(example_comp_data) +``` + +### Sex ratios + +The proportion female in each bin, female / (female + male), can show +trends in misfit for bins with small proportions, since those bins have small +residuals. Vertical lines are Jeffreys intervals based on the sample size in +each bin. + +```{r sex-ratio} +plot_comp_sex_ratio(example_comp_data, fleet = "Survey") +``` + +```{r sex-ratio-agg, fig.height = 4} +plot_comp_sex_ratio(example_comp_data, aggregate = TRUE) +``` + +### Mean age or length + +The time series of mean age or length was developed as a diagnostic for the +Francis (2011) data weighting method, but it is also a useful summary of +trends in the data and the fit. Thick intervals are based on the input sample +sizes and thin, capped intervals on the sample sizes after applying the +Francis weight shown in each panel label. A weight well below one, as for the +fishery here, means the input sample sizes are too large relative to how well +the model can fit the mean of the compositions. + +```{r mean, fig.height = 4} +set.seed(1) # the interval for the Francis weight is bootstrapped +plot_comp_mean(example_comp_data) +``` + +## Using model output + +With FIMS, pass the estimates directly: + +```{r fims, eval = FALSE} +estimates <- FIMS::get_estimates(fit) +plot_comp_residuals(estimates, comp_type = "age") +plot_comp_mean(estimates, comp_type = "length") +``` + +FIMS reports years as indices (`year_i`); add a `year` column to plot +calendar years. FIMS estimates do not currently include composition sample +sizes. Add an +`n` column, or supply Pearson residuals in a `pearson` column, to get +residuals and intervals. + +With Stock Synthesis, use the output of `r4ss::SS_output()`. Pearson residuals +and adjusted sample sizes are taken from the model output, and the Francis +weights match `r4ss::SSMethod.TA1.8()`: + +```{r ss3, eval = FALSE} +replist <- r4ss::SS_output("path/to/model") +plot_comp(replist, comp_type = "length", fleet = "FISHERY") +plot_comp_residuals(replist, comp_type = "age") +``` + +## References + +Francis, R.I.C.C. (2011). Data weighting in statistical fisheries stock +assessment models. Canadian Journal of Fisheries and Aquatic Sciences 68: +1124-1138. From 4f0cdeec933766b3f4bb5ada87ddb6481201f12b Mon Sep 17 00:00:00 2001 From: Eric Ward <5046884+ericward-noaa@users.noreply.github.com> Date: Fri, 16 Oct 2026 10:37:38 -0700 Subject: [PATCH 2/4] Update WORDLIST with additional terms Added new entries to the WORDLIST file. --- inst/WORDLIST | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/inst/WORDLIST b/inst/WORDLIST index 2d22da2f..f98d9134 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,3 +1,4 @@ +agedbase BAM BMSY Birthseason @@ -8,11 +9,16 @@ FMSY FTARGET Fmort Hennen +Jeffreys +lendbase Lifecycle +mis MSY Modelling NOAA +Nsamp ORCID +pearson Petrale Pre Preformatted @@ -21,6 +27,7 @@ Rda Rmarkdown Rmd Spawners +SSMethod StockSmart Subseason aa From aaf99ea6d368d1a450be801db68507d698cc295e Mon Sep 17 00:00:00 2001 From: ericward-noaa Date: Sun, 18 Oct 2026 10:31:12 -0700 Subject: [PATCH 3/4] update examples - change example / diagnostic dataset from simulated to big skate - added more plots from ian's list - more / better tests --- NAMESPACE | 6 +- R/data.R | 73 ++- R/plot_comp.R | 201 ++++-- R/plot_comp_diagnostics.R | 599 ++++++++++++++++++ R/utils_comp.R | 203 ++++-- data-raw/bigskate_comps.R | 57 ++ data-raw/example_comp_data.R | 70 -- data/bigskate_caal.rda | Bin 0 -> 74176 bytes data/bigskate_lencomp.rda | Bin 0 -> 56668 bytes data/example_comp_data.rda | Bin 9192 -> 0 bytes man/bigskate_caal.Rd | 42 ++ man/bigskate_lencomp.Rd | 47 ++ man/example_comp_data.Rd | 34 - man/plot_comp.Rd | 26 +- man/plot_comp_andre.Rd | 67 ++ man/plot_comp_bubble.Rd | 35 +- ...plot_comp_mean.Rd => plot_comp_francis.Rd} | 31 +- man/plot_comp_residual_dist.Rd | 63 ++ man/plot_comp_residual_pattern.Rd | 67 ++ man/plot_comp_residuals.Rd | 13 +- man/plot_comp_sample_size.Rd | 90 +++ man/plot_comp_sex_ratio.Rd | 21 +- man/prepare_comp_data.Rd | 47 +- tests/testthat/test-plot_comp.R | 98 ++- tests/testthat/test-plot_comp_diagnostics.R | 182 ++++++ vignettes/composition_diagnostics.Rmd | 221 +++++-- 26 files changed, 1935 insertions(+), 358 deletions(-) create mode 100644 R/plot_comp_diagnostics.R create mode 100644 data-raw/bigskate_comps.R delete mode 100644 data-raw/example_comp_data.R create mode 100644 data/bigskate_caal.rda create mode 100644 data/bigskate_lencomp.rda delete mode 100644 data/example_comp_data.rda create mode 100644 man/bigskate_caal.Rd create mode 100644 man/bigskate_lencomp.Rd delete mode 100644 man/example_comp_data.Rd create mode 100644 man/plot_comp_andre.Rd rename man/{plot_comp_mean.Rd => plot_comp_francis.Rd} (71%) create mode 100644 man/plot_comp_residual_dist.Rd create mode 100644 man/plot_comp_residual_pattern.Rd create mode 100644 man/plot_comp_sample_size.Rd create mode 100644 tests/testthat/test-plot_comp_diagnostics.R diff --git a/NAMESPACE b/NAMESPACE index 02d34db4..9ffdce67 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,9 +13,13 @@ export(plot_biomass) export(plot_biomass_at_age) export(plot_catch_comp) export(plot_comp) +export(plot_comp_andre) export(plot_comp_bubble) -export(plot_comp_mean) +export(plot_comp_francis) +export(plot_comp_residual_dist) +export(plot_comp_residual_pattern) export(plot_comp_residuals) +export(plot_comp_sample_size) export(plot_comp_sex_ratio) export(plot_discard) export(plot_fishing_mortality) diff --git a/R/data.R b/R/data.R index a182e4f8..60474fcf 100644 --- a/R/data.R +++ b/R/data.R @@ -42,25 +42,64 @@ #' "example_data" -#' Example composition data +#' Big Skate length composition data #' -#' Simulated sex-specific age compositions for a fishery (2001-2020) and a -#' survey (2005-2020), used to demonstrate the composition plotting -#' functions. Observed fishery compositions were generated with dome-shaped -#' selectivity while the expected values assume asymptotic selectivity, so -#' the fishery shows a pattern of misfit at older ages. See -#' `data-raw/example_comp_data.R` for the simulation code. +#' Length compositions and fits from the 2019 Big Skate stock assessment for +#' the U.S. West Coast (`BigSkate_2019` in the Stock Synthesis test models), +#' the model used for the r4ss example plots at +#' . The data are the `lendbase` +#' element of `r4ss::SS_output()` with columns renamed to stockplotr's +#' conventions. See `data-raw/bigskate_comps.R`. #' -#' @format A tibble with 1080 rows and 8 variables: +#' Compositions are sex-specific, with female and male proportions summing to +#' one within each year, fleet, and partition. `Fishery_current` has separate +#' retained and discarded compositions. +#' +#' @format A tibble with 3626 rows and 11 variables: +#' \describe{ +#' \item{comp_type}{Type of composition ("length")} +#' \item{fleet}{Fleet name: "Fishery_current", "WCGBTS", or "Triennial"} +#' \item{year}{Year of the observation (`Yr` in r4ss)} +#' \item{month}{Month of the observation} +#' \item{sex}{"female" or "male"} +#' \item{part}{Partition: 0 = whole catch, 1 = discard, 2 = retained} +#' \item{bin}{Lower edge of the length bin (cm)} +#' \item{observed}{Observed proportion (`Obs` in r4ss)} +#' \item{expected}{Expected proportion (`Exp` in r4ss)} +#' \item{pearson}{Pearson residual reported by Stock Synthesis} +#' \item{n}{Adjusted input sample size (`Nsamp_adj` in r4ss)} +#' } +#' @source Taylor, I.G., Gertseva, V., Stephens, A., and Bizzarro, J. (2019). Status of +#' Big Skate (Beringraja binoculata) off the U.S. Pacific Coast in 2019. +#' Pacific Fishery Management Council, Portland, OR. +#' @seealso [bigskate_caal], [prepare_comp_data()], [plot_comp()] +"bigskate_lencomp" + +#' Big Skate conditional age-at-length data +#' +#' Conditional age-at-length data and fits from the 2019 Big Skate stock +#' assessment (see [bigskate_lencomp]). The data are the `condbase` element +#' of `r4ss::SS_output()` with columns renamed to stockplotr's conventions. +#' Each age composition is for one sex and one length bin, and sums to one. +#' See `data-raw/bigskate_comps.R`. +#' +#' @format A tibble with 6560 rows and 12 variables: #' \describe{ #' \item{comp_type}{Type of composition ("age")} -#' \item{fleet}{Fleet or survey name} -#' \item{year}{Year of the observation} -#' \item{sex}{"female" or "male"; proportions sum to one across both sexes within a year and fleet} -#' \item{bin}{Age bin} -#' \item{observed}{Observed proportion} -#' \item{expected}{Model-expected proportion} -#' \item{n}{Input sample size} +#' \item{fleet}{Fleet name: "Fishery_current" or "WCGBTS"} +#' \item{year}{Year of the observation (`Yr` in r4ss)} +#' \item{month}{Month of the observation} +#' \item{sex}{"female" or "male"} +#' \item{part}{Partition: 0 = whole catch, 1 = discard, 2 = retained} +#' \item{length_bin}{Length bin the ages are conditioned on (`Lbin_lo` in r4ss)} +#' \item{bin}{Age} +#' \item{observed}{Observed proportion at age within the length bin} +#' \item{expected}{Expected proportion at age within the length bin} +#' \item{pearson}{Pearson residual reported by Stock Synthesis} +#' \item{n}{Adjusted input sample size (`Nsamp_adj` in r4ss)} #' } -#' @seealso [prepare_comp_data()], [plot_comp()] -"example_comp_data" +#' @source Taylor, I.G., Gertseva, V., Stephens, A., and Bizzarro, J. (2019). Status of +#' Big Skate (Beringraja binoculata) off the U.S. Pacific Coast in 2019. +#' Pacific Fishery Management Council, Portland, OR. +#' @seealso [bigskate_lencomp], [prepare_comp_data()], [plot_comp_andre()] +"bigskate_caal" diff --git a/R/plot_comp.R b/R/plot_comp.R index 83d42ec8..851320c2 100644 --- a/R/plot_comp.R +++ b/R/plot_comp.R @@ -7,7 +7,7 @@ #' #' @param dat A data frame of composition data in any format accepted by #' [prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` -#' table, or a tidy data frame like [example_comp_data]. +#' table, or a tidy data frame like [bigskate_lencomp]. #' @param show_expected Logical. TRUE/FALSE; overlay the expected values as #' lines. Ignored if `dat` contains no expected values. #' @@ -19,8 +19,10 @@ #' #' Default: FALSE #' -#' @param show_n Logical. TRUE/FALSE; label each panel with its sample size -#' when sample sizes are available (not used when `aggregate = TRUE`). +#' @param show_n Logical. TRUE/FALSE; label each panel with its adjusted +#' input sample size ("N adj.") and, when expected values are shown, its +#' effective sample size ("N eff."), as in r4ss. Not used when +#' `aggregate = TRUE`. #' #' Default: TRUE #' @@ -41,19 +43,22 @@ #' created for every fleet and year combination; use `fleet` to focus on one #' fleet at a time. #' +#' @section r4ss equivalent: `r4ss::SSplotComps()` subplot 1 (by year) and +#' subplot 21 (aggregated across years). +#' #' @seealso [prepare_comp_data()], [plot_comp_bubble()], -#' [plot_comp_residuals()], [plot_comp_sex_ratio()], [plot_comp_mean()] +#' [plot_comp_residuals()], [plot_comp_sex_ratio()], [plot_comp_francis()] #' @export #' #' @examples #' # Observations only -#' plot_comp(example_comp_data, fleet = "Survey", show_expected = FALSE) +#' plot_comp(bigskate_lencomp, fleet = "WCGBTS", show_expected = FALSE) #' #' # Observed and expected -#' plot_comp(example_comp_data, fleet = "Fishery") +#' plot_comp(bigskate_lencomp, fleet = "Triennial") #' #' # All fleets aggregated across years -#' plot_comp(example_comp_data, aggregate = TRUE) +#' plot_comp(bigskate_lencomp, aggregate = TRUE) plot_comp <- function( dat, show_expected = TRUE, @@ -124,12 +129,21 @@ plot_comp <- function( plt <- plt + ggplot2::geom_hline(yintercept = 0, linewidth = 0.3) } - # Sample size labels + # Sample size labels, as in r4ss: adjusted input (N adj.) and effective + # (N eff.) sample sizes if (show_n && !aggregate && any(!is.na(comps$n))) { n_lab <- comps |> dplyr::filter(!is.na(.data$n)) |> dplyr::distinct(.data$comp_type, .data$fleet, .data$year, .data$n) |> - dplyr::mutate(label = paste0("N=", round(.data$n, 1))) + dplyr::mutate(label = paste0("N adj.=", signif(.data$n, 3))) + if (show_expected) { + n_lab <- n_lab |> + dplyr::left_join( + dplyr::select(comp_effn_table(comps), "comp_type", "fleet", "year", "effn"), + by = c("comp_type", "fleet", "year") + ) |> + dplyr::mutate(label = paste0(.data$label, "\nN eff.=", signif(.data$effn, 3))) + } plt <- plt + ggplot2::geom_text( data = n_lab, @@ -190,6 +204,12 @@ plot_comp <- function( #' #' Default: 6 #' +#' @param conditional Logical. TRUE/FALSE; plot conditional age-at-length +#' data (see [prepare_comp_data()]), with age on the y-axis, length bin on +#' the x-axis, and one panel per year. +#' +#' Default: FALSE +#' #' @returns A `ggplot2` object. #' #' @details Panels are created for each fleet, and for each sex when @@ -199,26 +219,45 @@ plot_comp <- function( #' absolute value of the residual. The maximum absolute residual for each #' panel is included in the panel label. #' +#' @section r4ss equivalent: `r4ss::SSplotComps()` subplot 2 (bubble plot of +#' observations or residuals) and subplot 3 (conditional age-at-length). +#' #' @seealso [prepare_comp_data()], [plot_comp_residuals()], [plot_comp()] #' @export #' #' @examples -#' # Observed proportions; strong year classes appear as diagonals -#' plot_comp_bubble(example_comp_data) +#' # Observed proportions +#' plot_comp_bubble(bigskate_lencomp) #' #' # Pearson residuals -#' plot_comp_bubble(example_comp_data, value = "pearson") +#' plot_comp_bubble(bigskate_lencomp, value = "pearson") +#' +#' # Residuals for conditional age-at-length data +#' plot_comp_bubble( +#' dplyr::filter(bigskate_caal, year %in% 2016:2018), +#' value = "pearson", +#' fleet = "WCGBTS", +#' conditional = TRUE +#' ) plot_comp_bubble <- function( dat, value = c("observed", "pearson", "expected"), comp_type = NULL, fleet = NULL, max_size = 6, - ncol = NULL + ncol = NULL, + conditional = FALSE ) { value <- match.arg(value) - comps <- prepare_comp_data(dat, comp_type = comp_type, fleet = fleet) + comps <- prepare_comp_data( + dat, + comp_type = if (conditional) "age" else comp_type, + fleet = fleet, + conditional = conditional + ) bin_label <- comp_bin_label(comps) + # Conditional age-at-length: age by length bin, one panel per year + x_var <- if (conditional) "length_bin" else "year" comps$value <- comps[[value]] comps <- dplyr::filter(comps, !is.na(.data$value)) if (nrow(comps) == 0) { @@ -233,19 +272,20 @@ plot_comp_bubble <- function( facet_vars <- c( if (length(unique(comps$comp_type)) > 1) "comp_type", - "fleet", - if (length(unique(comps$sex)) > 1) "sex" + if (!conditional || length(unique(comps$fleet)) > 1) "fleet", + if (length(unique(comps$sex)) > 1) "sex", + if (conditional) "year" ) if (value == "pearson") { # Add the max absolute residual to a single panel label, ordered by # comp type, fleet, and sex comps <- comps |> - dplyr::arrange(.data$comp_type, .data$fleet, .data$sex) |> + dplyr::arrange(.data$comp_type, .data$fleet, .data$sex, .data$year) |> dplyr::group_by(dplyr::across(dplyr::all_of(facet_vars))) |> dplyr::mutate( panel = paste0( paste(unlist(dplyr::cur_group()), collapse = ", "), - " (max = ", format(round(max(abs(.data$value)), 2), nsmall = 2), ")" + "\n(max = ", format(round(max(abs(.data$value)), 2), nsmall = 2), ")" ) ) |> dplyr::ungroup() |> @@ -258,7 +298,7 @@ plot_comp_bubble <- function( ) plt <- ggplot2::ggplot( comps, - ggplot2::aes(x = .data$year, y = .data$bin, size = abs(.data$value), fill = .data$sign) + ggplot2::aes(x = .data[[x_var]], y = .data$bin, size = abs(.data$value), fill = .data$sign) ) + ggplot2::geom_point(shape = 21, color = "black", alpha = 0.8) + ggplot2::scale_fill_manual( @@ -271,7 +311,7 @@ plot_comp_bubble <- function( } else { plt <- ggplot2::ggplot( comps, - ggplot2::aes(x = .data$year, y = .data$bin, size = .data$value) + ggplot2::aes(x = .data[[x_var]], y = .data$bin, size = .data$value) ) + ggplot2::geom_point(shape = 21, color = "black", fill = "gray40", alpha = 0.5) + ggplot2::labs(size = cap_first_letter(paste(value, "proportion"))) @@ -280,10 +320,10 @@ plot_comp_bubble <- function( plt + ggplot2::scale_size_area(max_size = max_size) + ggplot2::scale_x_continuous( - breaks = axis_breaks(comps$year), + breaks = if (conditional) ggplot2::waiver() else axis_breaks(comps$year), guide = ggplot2::guide_axis(minor.ticks = TRUE) ) + - ggplot2::labs(x = "Year", y = bin_label) + + ggplot2::labs(x = if (conditional) "Length bin" else "Year", y = bin_label) + theme_noaa() + comp_facet(facet_vars, ncol = ncol) } @@ -300,15 +340,18 @@ plot_comp_bubble <- function( #' @param ... Additional arguments passed to [plot_comp_bubble()]. #' #' @returns A `ggplot2` object. +#' @section r4ss equivalent: `r4ss::SSplotComps()` subplot 2 for residuals by +#' fleet and subplot 24 (residuals compared across fleets). +#' #' @seealso [plot_comp_bubble()], [prepare_comp_data()] #' @export #' #' @examples -#' plot_comp_residuals(example_comp_data) +#' plot_comp_residuals(bigskate_lencomp) #' -#' # Compare residuals across fleets for one sex +#' # Compare residuals across fleets for females #' plot_comp_residuals( -#' dplyr::filter(example_comp_data, sex == "female"), +#' dplyr::filter(bigskate_lencomp, sex == "female"), #' ncol = 1 #' ) plot_comp_residuals <- function(dat, ...) { @@ -337,16 +380,22 @@ plot_comp_residuals <- function(dat, ...) { #' #' @details Requires sex-specific compositions with both "female" and #' "male" values in the `sex` column of `dat`. Points show observed ratios -#' and lines show expected ratios. When `aggregate = TRUE`, female and male +#' and lines show expected ratios. As in r4ss, the smallest observed +#' proportion in each composition (such as the small constant Stock Synthesis +#' adds to every bin) is subtracted from the observed and expected values +#' first, so bins with no fish observed are omitted. When `aggregate = TRUE`, female and male #' compositions are summed across years (weighted by sample size when #' available) before calculating ratios. #' +#' @section r4ss equivalent: `r4ss::SSplotSexRatio()` with +#' `sexratio.option = 2` (female:total). +#' #' @seealso [prepare_comp_data()], [plot_comp()] #' @export #' #' @examples -#' plot_comp_sex_ratio(example_comp_data, fleet = "Survey") -#' plot_comp_sex_ratio(example_comp_data, aggregate = TRUE) +#' plot_comp_sex_ratio(bigskate_lencomp, fleet = "WCGBTS") +#' plot_comp_sex_ratio(bigskate_lencomp, aggregate = TRUE) plot_comp_sex_ratio <- function( dat, aggregate = FALSE, @@ -361,9 +410,19 @@ plot_comp_sex_ratio <- function( cli::cli_abort("Sex ratios require compositions with both {.val female} and {.val male} values in the {.field sex} column.") } - # Females and males side by side, weighted by sample size when available + # Females and males side by side, weighted by sample size when available. + # As in r4ss, the smallest observation in each composition (e.g., the + # constant Stock Synthesis adds to every bin) is subtracted first, so that + # bins without fish do not appear as 50:50 sex ratios. wide <- comps |> dplyr::filter(.data$sex %in% c("female", "male")) |> + dplyr::group_by(.data$comp_type, .data$fleet, .data$year) |> + dplyr::mutate( + min_obs = min(.data$observed, na.rm = TRUE), + observed = pmax(.data$observed - .data$min_obs, 0), + expected = pmax(.data$expected - .data$min_obs, 0) + ) |> + dplyr::ungroup() |> dplyr::mutate(w = dplyr::if_else(is.na(.data$n), 1, .data$n)) |> dplyr::select("comp_type", "fleet", "year", "sex", "bin", "observed", "expected", "n", "w") |> tidyr::pivot_wider(names_from = "sex", values_from = c("observed", "expected")) @@ -385,7 +444,11 @@ plot_comp_sex_ratio <- function( ratio_exp = dplyr::if_else(.data$has_exp, .data$f_exp / (.data$f_exp + .data$m_exp), NA_real_), # weighted sums equal the number of fish in the bin when w is the sample size # (at least 1, as in r4ss) - n_bin = dplyr::if_else(.data$has_n, pmax(.data$f_obs + .data$m_obs, 1), NA_real_) + n_bin = dplyr::if_else( + .data$has_n & .data$f_obs + .data$m_obs > 0, + pmax(.data$f_obs + .data$m_obs, 1), + NA_real_ + ) ) ratios$ratio_obs[!is.finite(ratios$ratio_obs)] <- NA_real_ ratios$ratio_exp[!is.finite(ratios$ratio_exp)] <- NA_real_ @@ -432,7 +495,7 @@ plot_comp_sex_ratio <- function( ggplot2::scale_y_continuous(limits = c(0, 1), breaks = c(0, 0.5, 1)) + ggplot2::labs( x = bin_label, - y = "Proportion female", + y = "Fraction female", shape = NULL, linetype = NULL, caption = if (!is.null(interval) && any(!is.na(ratios$n_bin))) { @@ -452,7 +515,7 @@ plot_comp_sex_ratio <- function( #------------------------------------------------------------------------------ -#' Plot mean age or length of compositions over time +#' Plot mean age or length with Francis (TA1.8) data weights #' #' Time series of the mean age or length in the observed and expected #' compositions. Developed as a diagnostic for the Francis (2011) data @@ -483,10 +546,11 @@ plot_comp_sex_ratio <- function( #' #' The Francis weight is \eqn{1 / \mathrm{var}(r)} where #' \eqn{r = (\bar{x}_o - \bar{x}_e) / SE} are the standardized residuals of -#' the mean across years (fleets need at least three years). As in -#' `r4ss::SSMethod.TA1.8()`, its 95% interval is calculated by bootstrapping -#' the standardized residuals (1000 resamples), so use [set.seed()] for -#' reproducible intervals. The weight assumes a multinomial likelihood and has not been +#' the mean across years. As in Stock Synthesis and +#' `r4ss::SSMethod.TA1.8()`, all partitions of a fleet (e.g., retained and +#' discarded) share one weight, and its 95% interval is calculated by +#' bootstrapping the standardized residuals (1000 resamples), so use +#' [set.seed()] for reproducible intervals. The weight assumes a multinomial likelihood and has not been #' adapted for Dirichlet-multinomial or other likelihoods. #' #' Without expected values, only the observed means are plotted. Without @@ -496,12 +560,15 @@ plot_comp_sex_ratio <- function( #' fisheries stock assessment models. Canadian Journal of Fisheries and #' Aquatic Sciences 68: 1124-1138. #' +#' @section r4ss equivalent: `r4ss::SSplotComps()` subplots 8 and 9, which +#' use `r4ss::SSMethod.TA1.8()`. +#' #' @seealso [prepare_comp_data()], [plot_comp()] #' @export #' #' @examples -#' plot_comp_mean(example_comp_data) -plot_comp_mean <- function( +#' plot_comp_francis(bigskate_lencomp) +plot_comp_francis <- function( dat, interval = 0.95, show_francis = TRUE, @@ -516,33 +583,40 @@ plot_comp_mean <- function( has_exp <- any(!is.na(means$mean_exp)) has_se <- any(!is.na(means$se)) - # Francis weights by fleet + # Francis weights by fleet. As in Stock Synthesis and + # r4ss::SSMethod.TA1.8(), partitions of a fleet share one weight. weights <- NULL if (show_francis && has_exp && has_se) { + means$base_fleet <- base_fleet(means$fleet) weights <- means |> dplyr::filter(!is.na(.data$std_resid)) |> - dplyr::group_by(.data$comp_type, .data$fleet) |> - dplyr::filter(dplyr::n() > 2) |> + dplyr::group_by(.data$comp_type, .data$base_fleet) |> + dplyr::filter(dplyr::n() > 1) |> dplyr::summarise( - n_years = dplyr::n(), + n_parts = length(unique(.data$fleet)), weight = 1 / stats::var(.data$std_resid), - weight_lower = francis_boot_ci(.data$std_resid)[1], - weight_upper = francis_boot_ci(.data$std_resid)[2], + weight_ci = list(francis_boot_ci(.data$std_resid)), .groups = "drop" ) |> dplyr::mutate( - fleet_label = paste0( - .data$fleet, "\nFrancis weight = ", signif(.data$weight, 3), - " (", signif(.data$weight_lower, 3), "-", signif(.data$weight_upper, 3), ")" + weight_label = paste0( + "TA1.8 weight", dplyr::if_else(.data$n_parts > 1, " (all partitions)", ""), + " = ", signif(.data$weight, 3), " (", + signif(purrr::map_dbl(.data$weight_ci, 1), 3), "-", + signif(purrr::map_dbl(.data$weight_ci, 2), 3), ")" ) ) means <- means |> dplyr::left_join( - dplyr::select(weights, "comp_type", "fleet", "weight", "fleet_label"), - by = c("comp_type", "fleet") + dplyr::select(weights, "comp_type", "base_fleet", "weight", "weight_label"), + by = c("comp_type", "base_fleet") ) |> dplyr::mutate( - fleet = dplyr::if_else(is.na(.data$fleet_label), .data$fleet, .data$fleet_label), + fleet = dplyr::if_else( + is.na(.data$weight_label), + .data$fleet, + paste0(.data$fleet, "\n", .data$weight_label) + ), se_adj = .data$se / sqrt(.data$weight) ) } @@ -585,11 +659,11 @@ plot_comp_mean <- function( caption <- NULL if (has_se) { - caption <- paste0(round(interval * 100), "% intervals based on input sample sizes") + caption <- paste0(round(interval * 100), "% intervals based on current sample sizes") if (!is.null(weights) && nrow(weights) > 0) { caption <- paste0( caption, - "; thinner capped intervals after Francis (2011) TA1.8 weighting" + "; thinner intervals (with capped ends) show result of further adjusting sample sizes (Francis TA1.8)" ) } } @@ -619,17 +693,32 @@ francis_boot_ci <- function(std_resid, n_boot = 1000) { nrow = length(std_resid) ) w <- apply(boot, 2, function(x) 1 / stats::var(x)) - as.vector(stats::quantile(w[is.finite(w)], c(0.025, 0.975), na.rm = TRUE)) + as.vector(stats::quantile(w, c(0.025, 0.975), na.rm = TRUE)) } -# Mean bin of observed and expected compositions by year and fleet +# Mean bin of observed and expected compositions by year and fleet. As in +# r4ss::SSMethod.TA1.8(), sexes and partitions of a fleet in the same year +# are combined into one composition, with the mean sample size. comp_mean_table <- function(comps) { + comps <- comps |> + dplyr::mutate( + part_name = fleet_partition(.data$fleet), + fleet = base_fleet(.data$fleet) + ) comps |> + dplyr::group_by(.data$comp_type, .data$fleet) |> + dplyr::mutate( + fleet = if (length(unique(stats::na.omit(.data$part_name))) > 1) { + paste0(.data$fleet, " (", paste(sort(unique(stats::na.omit(.data$part_name))), collapse = " & "), ")") + } else { + .data$fleet + } + ) |> dplyr::group_by(.data$comp_type, .data$fleet, .data$year, .data$bin) |> dplyr::summarise( observed = sum(.data$observed, na.rm = TRUE), expected = if (all(is.na(.data$expected))) NA_real_ else sum(.data$expected, na.rm = TRUE), - n = dplyr::first(.data$n), + n = mean(.data$n), .groups = "drop" ) |> dplyr::group_by(.data$comp_type, .data$fleet, .data$year) |> @@ -642,7 +731,7 @@ comp_mean_table <- function(comps) { } else { sum(.data$bin^2 * .data$expected) / sum(.data$expected) - .data$mean_exp[1]^2 }, - n = dplyr::first(.data$n), + n = mean(.data$n), .groups = "drop" ) |> dplyr::filter(is.finite(.data$mean_obs)) |> diff --git a/R/plot_comp_diagnostics.R b/R/plot_comp_diagnostics.R new file mode 100644 index 00000000..b1c74c57 --- /dev/null +++ b/R/plot_comp_diagnostics.R @@ -0,0 +1,599 @@ +#' Plot input versus effective sample size of compositions +#' +#' Compare the input (or adjusted input) sample size of each composition with +#' its effective sample size, the sample size implied by how well the model +#' fits the composition. This is the diagnostic behind the McAllister and +#' Ianelli (1997) data weighting method. +#' +#' @inheritParams plot_comp +#' @param dat Composition data in any format accepted by +#' [prepare_comp_data()], or [convert_output()] output from Stock Synthesis +#' that contains the `FIT_LEN_COMPS` or `FIT_AGE_COMPS` tables (as in +#' `stockplotr::example_data`), from which the adjusted input (`nsamp_adj`) +#' and effective (`effn`) sample sizes are taken. +#' @param show_years Logical. TRUE/FALSE; label each point with its year. +#' +#' Default: FALSE +#' +#' @returns A `ggplot2` object. +#' +#' @details For each composition (year and fleet), the effective sample size +#' is +#' \deqn{N_{eff} = \sum_b e_b (1 - e_b) / \sum_b (o_b - e_b)^2} +#' where \eqn{o_b} and \eqn{e_b} are the observed and expected proportions in +#' bin \eqn{b} (McAllister and Ianelli 1997), the same calculation used by +#' Stock Synthesis. +#' +#' Each panel shows a 1:1 line, a loess smoother (dashed red, when there are +#' more than six distinct input sample sizes), the arithmetic mean of the +#' input sample sizes (vertical dashed line), and the harmonic mean of the +#' effective sample sizes (horizontal dashed line). The ratio of the harmonic +#' mean effective sample size to the mean input sample size, the +#' McAllister-Ianelli weight, is included in each panel label. Ratios below +#' one suggest that input sample sizes are too large relative to the fit. As +#' in Stock Synthesis, the weight is calculated across all partitions of a +#' fleet; multiplying it by the current variance adjustment gives the +#' `Recommend_var_adj` reported by Stock Synthesis. +#' +#' Effective sample sizes from this formula are not appropriate for +#' compositions fit with a Dirichlet-multinomial likelihood. +#' +#' @references McAllister, M.K., and Ianelli, J.N. (1997). Bayesian stock +#' assessment using catch-age data and the sampling-importance resampling +#' algorithm. Canadian Journal of Fisheries and Aquatic Sciences 54: 284-300. +#' +#' @section r4ss equivalent: `r4ss::SSplotComps()` subplot 7 ("N-EffN +#' comparison"). +#' +#' @seealso [prepare_comp_data()], [plot_comp_francis()] +#' @export +#' +#' @examples +#' plot_comp_sample_size(bigskate_lencomp) +#' +#' # Stock Synthesis output converted with convert_output() +#' plot_comp_sample_size(stockplotr::example_data, comp_type = "length") +plot_comp_sample_size <- function( + dat, + comp_type = NULL, + fleet = NULL, + show_years = FALSE, + ncol = NULL +) { + if (is_ss3_fit_summary(dat)) { + if (!is.null(comp_type)) comp_type <- match.arg(comp_type, c("age", "length")) + sizes <- comp_sample_size_from_ss3(dat, comp_type = comp_type) + if (!is.null(fleet)) { + sizes <- sizes[sizes$fleet %in% as.character(fleet), , drop = FALSE] + } + if (nrow(sizes) == 0) { + cli::cli_abort("No sample sizes remain after filtering by {.arg comp_type} and {.arg fleet}.") + } + } else { + comps <- prepare_comp_data(dat, comp_type = comp_type, fleet = fleet) + sizes <- comp_effn_table(comps) + } + sizes <- dplyr::filter(sizes, is.finite(.data$n), is.finite(.data$effn)) + if (nrow(sizes) == 0) { + cli::cli_abort(c( + "Effective sample sizes could not be calculated.", + "i" = "Supply {.field expected} values and sample sizes ({.field n})." + )) + } + + facet_vars <- c(if (length(unique(sizes$comp_type)) > 1) "comp_type", "fleet") + # Harmonic mean effective N and mean input N by panel, and the + # McAllister-Ianelli weight by fleet. As in Stock Synthesis, partitions of + # a fleet share one weight. + sizes$base_fleet <- base_fleet(sizes$fleet) + mi <- sizes |> + dplyr::group_by(.data$comp_type, .data$base_fleet) |> + dplyr::summarise( + n_parts = length(unique(.data$fleet)), + mi_weight = (1 / mean(1 / .data$effn)) / mean(.data$n), + .groups = "drop" + ) + summ <- sizes |> + dplyr::group_by(dplyr::across(dplyr::all_of(unique(c("comp_type", facet_vars, "base_fleet"))))) |> + dplyr::summarise( + mean_n = mean(.data$n), + hmean_effn = 1 / mean(1 / .data$effn), + .groups = "drop" + ) |> + dplyr::left_join(mi, by = c("comp_type", "base_fleet")) |> + dplyr::mutate( + panel = paste0( + .data$fleet, "\nMcAllister-Ianelli weight", + dplyr::if_else(.data$n_parts > 1, " (all partitions)", ""), + " = ", signif(.data$mi_weight, 3) + ) + ) + sizes <- dplyr::left_join(sizes, summ, by = unique(c("comp_type", facet_vars, "base_fleet"))) + + # Loess smoother by panel when there are enough distinct sample sizes + smooth <- lapply(split(sizes, sizes$panel), function(d) { + if (length(unique(d$n)) <= 6 || diff(range(d$n)) <= 2) { + return(NULL) + } + fit <- suppressWarnings(stats::loess(effn ~ n, data = d, degree = 1)) + d <- d[order(d$n), ] + d$fit <- stats::predict(fit, newdata = data.frame(n = d$n)) + d + }) + smooth <- dplyr::bind_rows(smooth) + + plt <- ggplot2::ggplot(sizes, ggplot2::aes(x = .data$n, y = .data$effn)) + + ggplot2::geom_abline(slope = 1, intercept = 0, color = "black") + + ggplot2::geom_vline( + data = summ, + ggplot2::aes(xintercept = .data$mean_n), + linetype = "22", + color = "#0085CA" + ) + + ggplot2::geom_hline( + data = summ, + ggplot2::aes(yintercept = .data$hmean_effn), + linetype = "22", + color = "#0085CA" + ) + + ggplot2::geom_point(color = "gray30", size = 2) + if (nrow(smooth) > 0) { + plt <- plt + + ggplot2::geom_line( + data = smooth, + ggplot2::aes(x = .data$n, y = .data$fit), + color = "#D55E00", + linetype = "dashed" + ) + } + if (show_years) { + plt <- plt + + ggplot2::geom_text( + ggplot2::aes(label = .data$year), + hjust = -0.2, + size = 2.8 + ) + } + plt + + ggplot2::expand_limits(x = 0, y = 0) + + ggplot2::labs( + x = "Adjusted input sample size (N adj.)", + y = "Effective sample size (N eff.)", + caption = "Solid line: 1:1. Dashed blue lines: arithmetic mean N adj. and harmonic mean N eff." + ) + + theme_noaa() + + comp_facet(c(if ("comp_type" %in% facet_vars) "comp_type", "panel"), ncol = ncol, scales = "free") +} + +#------------------------------------------------------------------------------ + +#' Plot the distribution of composition residuals +#' +#' Quantile-quantile plot or histogram of Pearson residuals for each fleet, +#' to check for heavy tails, skewness, and outliers. +#' +#' @inheritParams plot_comp +#' @param type String. Type of plot. Options: "qq" (normal quantile-quantile +#' plot) or "histogram" (with a standard normal density overlaid). +#' +#' Default: "qq" +#' +#' @returns A `ggplot2` object. +#' +#' @details The standard deviation of the normalized residuals (SDNR) for +#' each fleet is included in the panel label. Values well above one suggest +#' that the compositions are given more weight (larger sample sizes) than the +#' fit supports. Pearson residuals for compositions are not expected to be +#' exactly normally distributed, especially for bins with small expected +#' proportions or small sample sizes, so treat departures in the tails with +#' some caution. +#' +#' @seealso [plot_comp_residuals()], [plot_comp_residual_pattern()], +#' [prepare_comp_data()] +#' @export +#' +#' @examples +#' plot_comp_residual_dist(bigskate_lencomp) +#' plot_comp_residual_dist(bigskate_lencomp, type = "histogram") +plot_comp_residual_dist <- function( + dat, + type = c("qq", "histogram"), + comp_type = NULL, + fleet = NULL, + ncol = NULL +) { + type <- match.arg(type) + comps <- comp_residuals_or_abort(dat, comp_type = comp_type, fleet = fleet) + facet_vars <- c(if (length(unique(comps$comp_type)) > 1) "comp_type", "fleet") + comps <- comps |> + dplyr::group_by(dplyr::across(dplyr::all_of(facet_vars))) |> + dplyr::mutate( + panel = paste0(.data$fleet, " (SDNR = ", format(round(stats::sd(.data$pearson), 2), nsmall = 2), ")") + ) |> + dplyr::ungroup() + + if (type == "qq") { + plt <- ggplot2::ggplot(comps, ggplot2::aes(sample = .data$pearson)) + + ggplot2::geom_qq_line(color = "#0085CA", linewidth = 0.8) + + ggplot2::geom_qq(size = 1, alpha = 0.5) + + ggplot2::labs(x = "Theoretical quantiles (standard normal)", y = "Pearson residual") + } else { + plt <- ggplot2::ggplot(comps, ggplot2::aes(x = .data$pearson)) + + ggplot2::geom_histogram( + ggplot2::aes(y = ggplot2::after_stat(.data$density)), + bins = 30, + fill = "gray60", + color = "white" + ) + + ggplot2::stat_function(fun = stats::dnorm, color = "#0085CA", linewidth = 0.8) + + ggplot2::labs(x = "Pearson residual", y = "Density") + } + plt + + theme_noaa() + + comp_facet(c(if ("comp_type" %in% facet_vars) "comp_type", "panel"), ncol = ncol, scales = "free") +} + +#------------------------------------------------------------------------------ + +#' Plot patterns in composition residuals by bin or year +#' +#' Plot the mean Pearson residual for each bin (across years) or each year +#' (across bins), with a runs test for non-random patterns in the signs of +#' the residuals. These plots summarize the stripes that can appear in +#' residual bubble plots, for example, consistently negative residuals at +#' older ages caused by mis-specified selectivity. +#' +#' @inheritParams plot_comp +#' @param by String. Summarize residuals by "bin" (age or length) or by +#' "year". +#' +#' Default: "bin" +#' +#' @returns A `ggplot2` object. +#' +#' @details Vertical lines are plus and minus two standard errors of the mean +#' residual. The runs test (Wald-Wolfowitz) is applied to the signs of the +#' residuals ordered by year (when `by = "bin"`) or by bin (when +#' `by = "year"`). Filled points have fewer runs than expected by chance +#' (one-sided p < 0.05), which indicates a non-random pattern of residuals. +#' When all residuals have the same sign, the p-value is the probability of +#' that happening by chance, \eqn{2 \times 0.5^n}. +#' Residuals are summarized separately for each fleet and sex. +#' +#' @seealso [plot_comp_residuals()], [plot_comp_residual_dist()], +#' [prepare_comp_data()] +#' @export +#' +#' @examples +#' plot_comp_residual_pattern(bigskate_lencomp) +#' plot_comp_residual_pattern(bigskate_lencomp, by = "year") +plot_comp_residual_pattern <- function( + dat, + by = c("bin", "year"), + comp_type = NULL, + fleet = NULL, + ncol = NULL +) { + by <- match.arg(by) + comps <- comp_residuals_or_abort(dat, comp_type = comp_type, fleet = fleet) + bin_label <- comp_bin_label(comps) + order_var <- if (by == "bin") "year" else "bin" + + summ <- comps |> + dplyr::arrange(.data[[order_var]]) |> + dplyr::group_by(.data$comp_type, .data$fleet, .data$sex, .data[[by]]) |> + dplyr::summarise( + mean_resid = mean(.data$pearson), + se = stats::sd(.data$pearson) / sqrt(dplyr::n()), + runs_p = runs_test(.data$pearson), + .groups = "drop" + ) |> + dplyr::mutate( + runs = factor( + dplyr::if_else(!is.na(.data$runs_p) & .data$runs_p < 0.05, "Non-random (p < 0.05)", "Random"), + levels = c("Non-random (p < 0.05)", "Random") + ) + ) + + facet_vars <- c( + if (length(unique(summ$comp_type)) > 1) "comp_type", + "fleet", + if (length(unique(summ$sex)) > 1) "sex" + ) + + ggplot2::ggplot(summ, ggplot2::aes(x = .data[[by]], y = .data$mean_resid)) + + ggplot2::geom_hline(yintercept = 0, color = "gray50") + + ggplot2::geom_linerange( + ggplot2::aes( + ymin = .data$mean_resid - 2 * .data$se, + ymax = .data$mean_resid + 2 * .data$se + ), + color = "gray40", + na.rm = TRUE + ) + + ggplot2::geom_point(ggplot2::aes(fill = .data$runs), shape = 21, size = 2.5) + + ggplot2::scale_fill_manual( + values = c("Non-random (p < 0.05)" = "gray10", "Random" = "white"), + drop = FALSE + ) + + ggplot2::labs( + x = if (by == "bin") bin_label else "Year", + y = "Mean Pearson residual", + fill = paste("Runs test across", if (by == "bin") "years" else "bins") + ) + + theme_noaa() + + comp_facet(facet_vars, ncol = ncol) +} + +#------------------------------------------------------------------------------ + +#' Plot Andre's mean age at length for conditional age-at-length data +#' +#' For conditional age-at-length data, plot the observed and expected mean +#' age in each length bin, and the standard error of the mean age, for each +#' year. These are "Andre's plots" from `r4ss::SSplotComps()` (subplot 12). +#' +#' @inheritParams plot_comp +#' @param dat Conditional age-at-length data in any format accepted by +#' [prepare_comp_data()] with `conditional = TRUE`: a tidy data frame with a +#' `length_bin` column (see [bigskate_caal]), or an +#' `r4ss::SS_output()` list (its `condbase` element is used). +#' @param interval Number. Coverage of the intervals around the observed +#' values. +#' +#' Default: 0.90 +#' +#' @returns A `ggplot2` object with one row of panels per year: mean age at +#' length on the left and standard error of the mean age on the right. +#' +#' @details Within each year and length bin, the observed and expected mean +#' ages are \eqn{\sum_a a\, o_a} and \eqn{\sum_a a\, e_a}, and the standard +#' errors are the corresponding standard deviations of age divided by +#' \eqn{\sqrt{N}}, where \eqn{N} is the number of fish aged in the length +#' bin. Following r4ss, the interval for the mean is the observed mean plus or +#' minus the normal quantile times the observed standard error, and the +#' interval for the standard error is based on the chi-square distribution. +#' Observed values outside the intervals, or expected values that +#' consistently differ from the observed values, suggest mis-specified growth +#' or variability in length at age. +#' +#' Length bins with no observations or no sample size are omitted. Plot one +#' fleet at a time with `fleet`, and subset years by filtering `dat`. +#' +#' @section r4ss equivalent: `r4ss::SSplotComps()` subplot 12 ("Andre's mean age +#' and std. dev. in conditional AAL"). +#' +#' @seealso [prepare_comp_data()], [plot_comp_bubble()] +#' @export +#' +#' @examples +#' plot_comp_andre( +#' dplyr::filter(bigskate_caal, year %in% 2016:2018), +#' fleet = "WCGBTS" +#' ) +plot_comp_andre <- function( + dat, + interval = 0.90, + fleet = NULL, + ncol = NULL +) { + comps <- prepare_comp_data(dat, comp_type = "age", fleet = fleet, conditional = TRUE) + if (length(unique(comps$fleet)) > 1) { + cli::cli_alert_info( + "Plotting {length(unique(comps$fleet))} fleets; use {.arg fleet} to plot one fleet at a time." + ) + } + z <- stats::qnorm(1 - (1 - interval) / 2) + stats_df <- comps |> + dplyr::group_by(.data$fleet, .data$year, .data$sex, .data$length_bin) |> + dplyr::filter( + max(.data$observed, na.rm = TRUE) > 1e-4, + !is.na(dplyr::first(.data$n)), + dplyr::first(.data$n) > 0 + ) |> + dplyr::summarise( + N = dplyr::first(.data$n), + obs_mean = sum(.data$bin * .data$observed) / sum(.data$observed), + obs_sd = sqrt(max(0, sum(.data$bin^2 * .data$observed) / sum(.data$observed) - .data$obs_mean[1]^2)), + exp_mean = sum(.data$bin * .data$expected) / sum(.data$expected), + exp_sd = sqrt(max(0, sum(.data$bin^2 * .data$expected) / sum(.data$expected) - .data$exp_mean[1]^2)), + .groups = "drop" + ) |> + dplyr::mutate( + obs_se = .data$obs_sd / sqrt(.data$N), + exp_se = .data$exp_sd / sqrt(.data$N) + ) + if (nrow(stats_df) == 0) { + cli::cli_abort("No conditional age-at-length data with observations and sample sizes found.") + } + + mean_df <- stats_df |> + dplyr::transmute( + .data$fleet, .data$year, .data$sex, .data$length_bin, + statistic = "Mean age", + observed = .data$obs_mean, + expected = .data$exp_mean, + lower = .data$obs_mean - z * .data$obs_se, + upper = .data$obs_mean + z * .data$obs_se + ) + se_df <- stats_df |> + dplyr::transmute( + .data$fleet, .data$year, .data$sex, .data$length_bin, + statistic = "SE of mean age", + observed = .data$obs_se, + expected = .data$exp_se, + lower = dplyr::if_else( + .data$N > 1, + .data$obs_se * sqrt(pmax(.data$N - 1, 0) / stats::qchisq(1 - (1 - interval) / 2, .data$N)), + NA_real_ + ), + upper = dplyr::if_else( + .data$N > 1, + .data$obs_se * sqrt(pmax(.data$N - 1, 0) / stats::qchisq((1 - interval) / 2, .data$N)), + NA_real_ + ) + ) + plot_df <- dplyr::bind_rows(mean_df, se_df) |> + dplyr::mutate(statistic = factor(.data$statistic, levels = c("Mean age", "SE of mean age"))) + + row_vars <- c( + if (length(unique(plot_df$fleet)) > 1) "fleet", + if (length(unique(plot_df$sex)) > 1) "sex", + "year" + ) + + ggplot2::ggplot(plot_df, ggplot2::aes(x = .data$length_bin)) + + ggplot2::geom_ribbon( + ggplot2::aes(ymin = .data$lower, ymax = .data$upper), + fill = "gray90", + na.rm = TRUE + ) + + ggplot2::geom_line(ggplot2::aes(y = .data$lower), linetype = "dotted", na.rm = TRUE) + + ggplot2::geom_line(ggplot2::aes(y = .data$upper), linetype = "dotted", na.rm = TRUE) + + ggplot2::geom_line( + ggplot2::aes(y = .data$expected, linetype = "Expected"), + color = "#0085CA", + linewidth = 0.8, + na.rm = TRUE + ) + + ggplot2::geom_point(ggplot2::aes(y = .data$observed, shape = "Observed"), size = 1.5) + + ggplot2::facet_grid( + rows = ggplot2::vars(!!!rlang::syms(row_vars)), + cols = ggplot2::vars(.data$statistic), + scales = "free_y", + labeller = ggplot2::labeller(.multi_line = FALSE) + ) + + ggplot2::expand_limits(y = 0) + + ggplot2::labs( + x = "Length bin", + y = NULL, + shape = NULL, + linetype = NULL, + caption = paste0( + "Left: mean age at length (obs. and exp.) with ", round(interval * 100), + "% intervals based on adding ", round(z, 2), " SE of mean to the data.\n", + "Right: SE of mean age at length (obs. and exp.) with ", round(interval * 100), + "% intervals based on the chi-square distribution." + ) + ) + + theme_noaa() + + ggplot2::theme( + strip.text = ggplot2::element_text(size = 9), + axis.text = ggplot2::element_text(size = 8) + ) +} + +#------------------------------------------------------------------------------ +# Internal helpers +#------------------------------------------------------------------------------ + +# Prepare comps and keep rows with residuals, or abort with a hint +comp_residuals_or_abort <- function(dat, comp_type = NULL, fleet = NULL) { + comps <- prepare_comp_data(dat, comp_type = comp_type, fleet = fleet) + comps <- dplyr::filter(comps, is.finite(.data$pearson)) + if (nrow(comps) == 0) { + cli::cli_abort(c( + "No Pearson residuals available.", + "i" = "Supply a {.field pearson} column, or {.field expected} values and sample sizes ({.field n}) so residuals can be calculated." + )) + } + comps +} + +# One-sided Wald-Wolfowitz runs test on the signs of x (in order). Returns +# the p-value for fewer runs than expected (positive autocorrelation). +runs_test <- function(x) { + s <- sign(x[x != 0 & !is.na(x)]) + n1 <- sum(s > 0) + n2 <- sum(s < 0) + n <- n1 + n2 + if (n < 3) { + return(NA_real_) + } + # A single run: probability that all n signs are the same by chance + if (n1 == 0 || n2 == 0) { + return(2 * 0.5^n) + } + runs <- 1 + sum(s[-1] != s[-length(s)]) + mu <- 2 * n1 * n2 / n + 1 + v <- 2 * n1 * n2 * (2 * n1 * n2 - n) / (n^2 * (n - 1)) + if (v <= 0) { + return(NA_real_) + } + stats::pnorm((runs - mu) / sqrt(v)) +} + +# Input and effective (McAllister-Ianelli) sample size by composition +comp_effn_table <- function(comps) { + comps |> + dplyr::filter(!is.na(.data$expected)) |> + dplyr::group_by(.data$comp_type, .data$fleet, .data$year) |> + dplyr::summarise( + n = dplyr::first(.data$n), + effn = sum(.data$expected * (1 - .data$expected)) / + sum((.data$observed - .data$expected)^2), + .groups = "drop" + ) +} + +# Does dat contain Stock Synthesis FIT_*_COMPS tables from convert_output()? +is_ss3_fit_summary <- function(dat) { + is.data.frame(dat) && + all(c("module_name", "label", "estimate") %in% names(dat)) && + any(dat$module_name %in% c("FIT_LEN_COMPS", "FIT_AGE_COMPS", "FIT_SIZE_COMPS") & + dat$label %in% "effn") +} + +# Sample sizes from the Stock Synthesis FIT_*_COMPS tables in +# convert_output() output. Each composition is identified by its module, +# fleet, year, and other indexing columns; compositions that cannot be +# separated (e.g., conditional age-at-length, which lack the length bin in +# the converted output) are dropped. +comp_sample_size_from_ss3 <- function(dat, comp_type = NULL) { + keys <- intersect( + c("module_name", "fleet", "year", "sex", "season", "subseason", "month", "time"), + names(dat) + ) + fit <- dat[dat$module_name %in% c("FIT_LEN_COMPS", "FIT_AGE_COMPS", "FIT_SIZE_COMPS") & + dat$label %in% c("nsamp_adj", "effn", "part", "ageerr"), c(keys, "label", "estimate")] + # convert_output() keeps the values from each row of the SS3 table + # together, in order, so a new composition starts at each "part" (or + # "nsamp_adj" in output without partitions) + first_label <- if ("part" %in% fit$label) "part" else "nsamp_adj" + fit <- fit |> + dplyr::group_by(.data$module_name) |> + dplyr::mutate(comp_id = cumsum(.data$label == first_label)) |> + dplyr::ungroup() + wide <- fit |> + dplyr::group_by(.data$module_name, .data$comp_id) |> + dplyr::filter(all(c("nsamp_adj", "effn") %in% .data$label), !any(duplicated(.data$label))) |> + dplyr::ungroup() |> + tidyr::pivot_wider(names_from = "label", values_from = "estimate") |> + dplyr::filter(!is.na(.data$year), !is.na(.data$fleet)) + if (!"part" %in% names(wide)) wide$part <- NA_real_ + if (!"ageerr" %in% names(wide)) wide$ageerr <- NA_real_ + wide$comp_type <- dplyr::if_else(wide$module_name == "FIT_AGE_COMPS", "age", "length") + if (!is.null(comp_type)) wide <- wide[wide$comp_type == comp_type, , drop = FALSE] + # Several compositions for the same fleet, year, sex, and partition are + # conditional age-at-length data, which lack the length bin in the + # converted output + wide <- wide |> + dplyr::group_by(dplyr::across(dplyr::all_of(c(keys, "part", "ageerr")))) |> + dplyr::mutate(n_comps = dplyr::n()) |> + dplyr::ungroup() + if (any(wide$n_comps > 1)) { + cli::cli_alert_info( + "Dropped {sum(wide$n_comps > 1)} composition{?s} that appear to be conditional age-at-length data." + ) + } + wide |> + dplyr::filter(.data$n_comps == 1) |> + dplyr::mutate( + year = suppressWarnings(as.numeric(.data$year)), + n = .data$nsamp_adj + ) |> + dplyr::group_by(.data$comp_type) |> + dplyr::mutate(fleet = label_partition(.data$fleet, .data$part)) |> + dplyr::ungroup() |> + dplyr::select("comp_type", "fleet", "year", "n", "effn") +} diff --git a/R/utils_comp.R b/R/utils_comp.R index 412cb802..ebf02a20 100644 --- a/R/utils_comp.R +++ b/R/utils_comp.R @@ -3,14 +3,15 @@ #' Reshape age or length composition data (observed and, optionally, #' expected proportions) into the tidy format used by the composition #' plotting functions ([plot_comp()], [plot_comp_bubble()], -#' [plot_comp_residuals()], [plot_comp_sex_ratio()], and [plot_comp_mean()]). +#' [plot_comp_residuals()], [plot_comp_sex_ratio()], and [plot_comp_francis()]). #' #' @param dat A data frame of composition data. The following formats are #' recognized automatically: #' \describe{ #' \item{Tidy composition data}{Columns `year`, `bin`, and `observed`, with -#' optional columns `fleet`, `sex`, `expected`, `n` (input or adjusted -#' sample size), `pearson`, and `comp_type`. See [example_comp_data].} +#' optional columns `fleet`, `sex`, `part` (partition: 0 = whole catch, +#' 1 = discard, 2 = retained), `expected`, `n` (input or adjusted sample +#' size), `pearson`, and `comp_type`. See [bigskate_lencomp].} #' \item{FIMS output}{Output from FIMS (e.g., `FIMS::get_estimates()` or #' [convert_output()] with `model = "fims"`) that contains `observed` and #' `expected` columns. Rows whose `label` contains "comp" are kept and the @@ -26,28 +27,42 @@ #' `lendbase` or `agedbase` elements (columns `Yr`, `Fleet`, `Sex`, `Bin`, #' `Obs`, `Exp`, `Pearson`, `Nsamp_adj`, ...). Conditional #' age-at-length rows are dropped from `agedbase` so that only marginal age -#' compositions remain.} +#' compositions remain, unless `conditional = TRUE`.} #' } +#' For conditional age-at-length data (`conditional = TRUE`), tidy data also +#' need a `length_bin` column giving the length bin that each age +#' composition is conditioned on (see [bigskate_caal]). #' @param comp_type String. Type of composition to keep when `dat` contains #' more than one. Options: "age", "length", or NULL (keep all). #' #' Default: NULL #' -#' @param fleet Character or numeric vector. Fleet(s) to keep. NULL keeps all -#' fleets. +#' @param fleet Character or numeric vector. Fleet(s) to keep, matching +#' either the fleet name (e.g., "Fishery_current") or the fleet name with its +#' partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. #' #' Default: NULL #' #' @param normalize Logical. TRUE/FALSE; rescale observed and expected values #' so that they sum to one within each year, fleet, and composition type -#' (summing across sexes so that sex-specific compositions remain jointly -#' normalized). Use TRUE when `dat` contains counts rather than proportions. +#' (and length bin for conditional data). Sex-specific compositions are +#' normalized jointly across sexes, unless each sex already sums to one on +#' its own (single-sex compositions). Use TRUE when `dat` contains counts +#' rather than proportions. #' #' Default: TRUE #' +#' @param conditional Logical. TRUE/FALSE; keep conditional age-at-length +#' data instead of marginal compositions. Conditional compositions are +#' normalized within each length bin. Used by [plot_comp_andre()] and +#' [plot_comp_bubble()]. +#' +#' Default: FALSE +#' #' @returns A tibble with one row per year, fleet, sex, and bin and columns #' `comp_type`, `fleet`, `year`, `sex`, `bin`, `observed`, `expected`, `n`, -#' and `pearson`. Columns that cannot be determined from `dat` are `NA`. +#' and `pearson` (plus `length_bin` when `conditional = TRUE`). Columns that +#' cannot be determined from `dat` are `NA`. #' #' @details When Pearson residuals are not supplied, they are calculated #' assuming a multinomial distribution as @@ -57,11 +72,11 @@ #' residuals are left as `NA`. #' #' @seealso [plot_comp()], [plot_comp_bubble()], [plot_comp_residuals()], -#' [plot_comp_sex_ratio()], [plot_comp_mean()] +#' [plot_comp_sex_ratio()], [plot_comp_francis()] #' @export #' #' @examples -#' comps <- prepare_comp_data(example_comp_data, fleet = "Survey") +#' comps <- prepare_comp_data(bigskate_lencomp, fleet = "WCGBTS") #' head(comps) #' #' # Data in the stockplotr long format are reshaped automatically @@ -77,12 +92,21 @@ prepare_comp_data <- function( dat, comp_type = NULL, fleet = NULL, - normalize = TRUE + normalize = TRUE, + conditional = FALSE ) { - # Full r4ss::SS_output() list: combine length and marginal age comps + # Full r4ss::SS_output() list: combine length and marginal age comps, or + # use the conditional age-at-length data if (!is.data.frame(dat) && is.list(dat) && - any(c("lendbase", "agedbase") %in% names(dat))) { - dbase <- dplyr::bind_rows(dat[["lendbase"]], dat[["agedbase"]]) + any(c("lendbase", "agedbase", "condbase") %in% names(dat))) { + dbase <- if (conditional) { + dat[["condbase"]] + } else { + dplyr::bind_rows(dat[["lendbase"]], dat[["agedbase"]]) + } + if (is.null(dbase) || nrow(dbase) == 0) { + cli::cli_abort("No {if (conditional) 'conditional age-at-length' else 'composition'} data found in the r4ss output.") + } if (!is.null(dat[["FleetNames"]]) && nrow(dbase) > 0) { dbase$Fleet_Name <- dat[["FleetNames"]][dbase$Fleet] } @@ -92,11 +116,15 @@ prepare_comp_data <- function( cli::cli_abort("{.arg dat} must be a data frame or an {.code r4ss::SS_output()} list.") } # Return early if the data are already prepared - if (inherits(dat, "stockplotr_comp")) { + prepared <- inherits(dat, "stockplotr_comp") + if (prepared) { out <- dat + if (conditional != ("length_bin" %in% names(out))) { + cli::cli_abort("{.arg dat} was prepared with {.code conditional = {!conditional}}.") + } } else { out <- switch(detect_comp_format(dat), - "r4ss" = comp_from_r4ss(dat), + "r4ss" = comp_from_r4ss(dat, conditional = conditional), "obs_exp_cols" = comp_from_obs_exp_cols(dat), "long" = comp_from_long(dat), "tidy" = comp_from_tidy(dat), @@ -105,6 +133,20 @@ prepare_comp_data <- function( "i" = "Supply a data frame with columns {.field year}, {.field bin}, and {.field observed} (see {.code ?prepare_comp_data})." )) ) + has_lbin <- any(!is.na(out$length_bin)) + if (conditional && !has_lbin) { + cli::cli_abort(c( + "No conditional age-at-length data found in {.arg dat}.", + "i" = "Tidy data need a {.field length_bin} column." + )) + } + if (!conditional && has_lbin && length(unique(stats::na.omit(out$length_bin))) > 1) { + cli::cli_abort(c( + "{.arg dat} contains conditional age-at-length data ({.field length_bin}).", + "i" = "Use {.code conditional = TRUE}, e.g., with {.fn plot_comp_andre}." + )) + } + if (!conditional) out$length_bin <- NULL } # Filter to comp type and fleet @@ -118,20 +160,39 @@ prepare_comp_data <- function( ) } if (!is.null(fleet)) { - out <- out[out$fleet %in% as.character(fleet), , drop = FALSE] + # Match either the fleet name or the fleet name with its partition, + # e.g., "Fishery_current" or "Fishery_current (retained)" + fleet_base <- base_fleet(out$fleet) + keep <- out$fleet %in% as.character(fleet) | fleet_base %in% as.character(fleet) + out <- out[keep, , drop = FALSE] } if (nrow(out) == 0) { cli::cli_abort("No composition data remain after filtering by {.arg comp_type} and {.arg fleet}.") } - if (normalize && !inherits(dat, "stockplotr_comp")) { + if (normalize && !prepared) { + # Compositions are normalized jointly across sexes unless each sex + # already sums to one on its own (single-sex compositions, as is common + # for conditional age-at-length data) out <- out |> - dplyr::group_by(.data$comp_type, .data$fleet, .data$year) |> + dplyr::group_by(dplyr::across(dplyr::any_of( + c("comp_type", "fleet", "year", "length_bin") + ))) |> + dplyr::mutate( + sex_group = if (length(unique(.data$sex)) > 1 && + all(abs(tapply(.data$observed, .data$sex, sum, na.rm = TRUE) - 1) < 1e-3)) { + .data$sex + } else { + "joint" + } + ) |> + dplyr::group_by(.data$sex_group, .add = TRUE) |> dplyr::mutate( observed = .data$observed / sum(.data$observed, na.rm = TRUE), expected = .data$expected / sum(.data$expected, na.rm = TRUE) ) |> dplyr::ungroup() |> + dplyr::select(-"sex_group") |> # 0/0 when a year has no observations dplyr::mutate( observed = dplyr::if_else(is.nan(.data$observed), NA_real_, .data$observed), @@ -150,7 +211,9 @@ prepare_comp_data <- function( } out <- out |> - dplyr::arrange(.data$comp_type, .data$fleet, .data$year, .data$sex, .data$bin) + dplyr::arrange(dplyr::across(dplyr::any_of( + c("comp_type", "fleet", "year", "length_bin", "sex", "bin") + ))) class(out) <- unique(c("stockplotr_comp", class(tibble::as_tibble(out)))) out } @@ -235,25 +298,30 @@ finish_comp <- function(out) { out <- tibble::as_tibble(out) out$fleet <- as.character(out$fleet) out$sex <- standardize_sex(out$sex) - for (col in c("year", "bin", "observed", "expected", "n", "pearson")) { + if (!"length_bin" %in% names(out)) out$length_bin <- NA_real_ + for (col in c("year", "bin", "observed", "expected", "n", "pearson", "length_bin")) { out[[col]] <- suppressWarnings(as.numeric(out[[col]])) } out$fleet[is.na(out$fleet)] <- "All" out <- dplyr::filter(out, !is.na(.data$bin), !is.na(.data$year)) - out[, comp_cols] + out[, c(comp_cols, "length_bin")] } comp_from_tidy <- function(dat) { finish_comp(data.frame( comp_type = pull_col(dat, "comp_type", NA_character_), - fleet = pull_col(dat, c("fleet", "fleet_name"), "All"), + fleet = label_partition( + as.character(pull_col(dat, c("fleet", "fleet_name"), "All")), + pull_col(dat, "part") + ), year = pull_col(dat, "year"), sex = pull_col(dat, "sex"), bin = pull_col(dat, c("bin", "age", "length", "length_bins")), observed = pull_col(dat, "observed"), expected = pull_col(dat, c("expected", "predicted")), n = pull_col(dat, c("n", "sample_size", "nsamp", "nsamp_adj")), - pearson = pull_col(dat, c("pearson", "pearson_residual", "residual")) + pearson = pull_col(dat, c("pearson", "pearson_residual", "residual")), + length_bin = pull_col(dat, c("length_bin", "lbin", "lbin_lo")) )) } @@ -322,7 +390,7 @@ comp_from_long <- function(dat) { finish_comp(wide) } -comp_from_r4ss <- function(dat) { +comp_from_r4ss <- function(dat, conditional = FALSE) { dat <- as.data.frame(dat) # Drop conditional age-at-length data, keeping marginal age comps lo <- find_col(dat, "Lbin_lo") @@ -331,7 +399,13 @@ comp_from_r4ss <- function(dat) { if (!is.null(lo) && !is.null(hi)) { is_age <- if (all(is.na(kind))) rep(TRUE, nrow(dat)) else toupper(kind) %in% "AGE" range <- dat[[hi]] - dat[[lo]] - if (any(is_age) && length(unique(range[is_age])) > 1) { + multiple_ranges <- any(is_age) && length(unique(range[is_age])) > 1 + if (conditional) { + # Keep age rows conditioned on a length bin narrower than the full range + keep <- is_age & (if (multiple_ranges) range < max(range[is_age], na.rm = TRUE) else TRUE) + dat <- dat[keep, , drop = FALSE] + kind <- kind[keep] + } else if (multiple_ranges) { cli::cli_alert_info("Conditional age-at-length data removed; only marginal age compositions are kept.") keep <- !is_age | range == max(range[is_age], na.rm = TRUE) dat <- dat[keep, , drop = FALSE] @@ -346,17 +420,12 @@ comp_from_r4ss <- function(dat) { ) fleet <- as.character(pull_col(dat, c("Fleet_Name", "Fleet_name", "Fleet"), "All")) # Add partition to fleet name when a fleet has more than one partition - part <- pull_col(dat, "Part") - if (!all(is.na(part))) { - multi_part <- tapply(part, fleet, function(x) length(unique(x)) > 1) - part_name <- c("0" = "whole", "1" = "discard", "2" = "retained")[as.character(part)] - fleet <- ifelse(multi_part[fleet], paste0(fleet, " (", part_name, ")"), fleet) - } - finish_comp(data.frame( + fleet <- label_partition(fleet, pull_col(dat, "Part")) + out <- finish_comp(data.frame( comp_type = type, fleet = fleet, year = pull_col(dat, "Yr"), - sex = pull_col(dat, "Sex"), + sex = r4ss_sex(dat), bin = pull_col(dat, "Bin"), observed = pull_col(dat, "Obs"), expected = pull_col(dat, "Exp"), @@ -365,8 +434,56 @@ comp_from_r4ss <- function(dat) { suppressWarnings(as.numeric(pull_col(dat, "Nsamp_DM"))), suppressWarnings(as.numeric(pull_col(dat, c("Nsamp_adj", "N")))) ), - pearson = pull_col(dat, "Pearson") + pearson = pull_col(dat, "Pearson"), + length_bin = if (conditional && !is.null(lo)) dat[[lo]] else NA_real_ )) + # Single-sex male compositions are reported twice in the Stock Synthesis + # composition database (once for each internal sex code), with identical + # values, so keep one copy + dplyr::distinct(out) +} + +# Add the partition to fleet names, as in r4ss, when a fleet has data from +# more than one partition (0 = whole catch, 1 = discard, 2 = retained) +label_partition <- function(fleet, part) { + fleet <- as.character(fleet) + if (all(is.na(part))) { + return(fleet) + } + part_name <- c("0" = "whole catch", "1" = "discard", "2" = "retained")[as.character(part)] + multi_part <- tapply(part, fleet, function(x) length(unique(stats::na.omit(x))) > 1) + ifelse( + !is.na(part_name) & multi_part[fleet] %in% TRUE, + paste0(fleet, " (", part_name, ")"), + fleet + ) +} + +# Fleet name without the partition added by label_partition() +base_fleet <- function(fleet) { + sub(" \\((whole catch|discard|retained)\\)$", "", fleet) +} + +# Partition name added by label_partition(), or NA +fleet_partition <- function(fleet) { + pattern <- "^.* \\((whole catch|discard|retained)\\)$" + ifelse(grepl(pattern, fleet), sub(pattern, "\\1", fleet), NA_character_) +} + +# Sex from an r4ss composition database. r4ss adds a lowercase "sex" +# column (0 = unknown, 1 = female, 2 = male); the uppercase "Sex" column is +# an internal Stock Synthesis code where 1 means female or unknown, so +# single-sex male compositions (Sexes = 2) can have Sex = 1. +r4ss_sex <- function(dat) { + if ("sex" %in% names(dat)) { + return(dat[["sex"]]) + } + sexes <- pull_col(dat, "Sexes") + sex <- pull_col(dat, "Sex") + if (all(is.na(sexes))) { + return(sex) + } + dplyr::if_else(sexes == 3, sex, sexes) } # Axis label for the bin variable @@ -418,10 +535,14 @@ comp_facet <- function(vars, ncol = NULL, scales = "fixed") { if (length(vars) == 0) { return(NULL) } - ggplot2::facet_wrap( - ggplot2::vars(!!!rlang::syms(vars)), - ncol = ncol, - scales = scales, - labeller = ggplot2::labeller(.multi_line = FALSE) + list( + ggplot2::facet_wrap( + ggplot2::vars(!!!rlang::syms(vars)), + ncol = ncol, + scales = scales, + labeller = ggplot2::labeller(.multi_line = FALSE) + ), + # Fleet names with partitions and weights make long panel labels + ggplot2::theme(strip.text = ggplot2::element_text(size = 10)) ) } diff --git a/data-raw/bigskate_comps.R b/data-raw/bigskate_comps.R new file mode 100644 index 00000000..f2a96d5d --- /dev/null +++ b/data-raw/bigskate_comps.R @@ -0,0 +1,57 @@ +## Code to prepare `bigskate_lencomp` and `bigskate_caal` +# Composition data and fits from the 2019 Big Skate stock assessment +# (BigSkate_2019 in the Stock Synthesis test models), the model used for the +# r4ss example plots at https://r4ss.github.io/r4ss/BigSkate/. +# +# The test model includes Report.sso but not CompReport.sso, so the model is +# rerun at its maximum likelihood estimates (from ss3.par, without +# estimation) to write the composition database, then read with +# r4ss::SS_output(). + +model_dir <- file.path(tempdir(), "bigskate") +dir.create(model_dir, showWarnings = FALSE) + +# Get the model and the Stock Synthesis executable +r4ss::download_models(dir = model_dir) +bigskate_dir <- file.path(model_dir, "models", "BigSkate_2019") +r4ss::get_ss3_exe(dir = bigskate_dir) + +# Start from the estimated parameters in ss3.par and do not estimate +starter <- r4ss::SS_readstarter(file.path(bigskate_dir, "starter.ss"), verbose = FALSE) +starter[["init_values_src"]] <- 1 +r4ss::SS_writestarter(starter, dir = bigskate_dir, overwrite = TRUE, verbose = FALSE) +r4ss::run(dir = bigskate_dir, extras = "-maxfn 0 -phase 50 -nohess", exe = "ss3", skipfinished = FALSE) + +replist <- r4ss::SS_output( + bigskate_dir, + verbose = FALSE, printstats = FALSE, covar = FALSE, forecast = FALSE +) + +# Reshape r4ss composition databases to stockplotr's snake_case columns +tidy_dbase <- function(dbase, comp_type, fleet_names) { + out <- tibble::tibble( + comp_type = comp_type, + fleet = fleet_names[dbase[["Fleet"]]], + year = dbase[["Yr"]], + month = dbase[["Month"]], + # r4ss's lowercase "sex" (0 = unknown, 1 = female, 2 = male), not the + # Stock Synthesis "Sex" code, which is 1 for male-only compositions + sex = c("1" = "female", "2" = "male", "0" = "combined")[as.character(dbase[["sex"]])], + part = dbase[["Part"]], + length_bin = dbase[["Lbin_lo"]], + bin = dbase[["Bin"]], + observed = dbase[["Obs"]], + expected = dbase[["Exp"]], + pearson = dbase[["Pearson"]], + n = dbase[["Nsamp_adj"]] + ) + if (comp_type == "length") out[["length_bin"]] <- NULL + # Single-sex male compositions are reported twice in the composition + # database (once for each internal sex code) with identical values + dplyr::distinct(out) +} + +bigskate_lencomp <- tidy_dbase(replist[["lendbase"]], "length", replist[["FleetNames"]]) +bigskate_caal <- tidy_dbase(replist[["condbase"]], "age", replist[["FleetNames"]]) + +usethis::use_data(bigskate_lencomp, bigskate_caal, overwrite = TRUE) diff --git a/data-raw/example_comp_data.R b/data-raw/example_comp_data.R deleted file mode 100644 index 054a8681..00000000 --- a/data-raw/example_comp_data.R +++ /dev/null @@ -1,70 +0,0 @@ -## Code to prepare `example_comp_data` -# Simulated sex-specific age compositions for a fishery and a survey. -# Expected values come from a simple age-structured operating model. The -# observed fishery data are generated with dome-shaped selectivity while the -# expected values assume asymptotic selectivity, which creates a pattern of -# misfit at older ages that the composition diagnostics should reveal. -set.seed(20261016) - -years <- 2001:2020 -ages <- 1:15 -n_years <- length(years) -n_ages <- length(ages) - -M <- c(female = 0.20, male = 0.28) -F_year <- 0.15 + 0.15 * sin(seq(0, pi, length.out = n_years)) -rec_dev <- stats::rnorm(n_years + n_ages, 0, 0.5) -# A few strong year classes to show up as diagonals in bubble plots -rec_dev[n_ages + which(years %in% c(2003, 2010, 2016)) - 1] <- c(1.3, 1.1, 1.2) - -logistic <- function(a, a50, slope) 1 / (1 + exp(-slope * (a - a50))) -sel_fishery_model <- logistic(ages, 5, 1.2) -sel_fishery_true <- sel_fishery_model * exp(-0.3 * pmax(ages - 7, 0)) -sel_survey <- logistic(ages, 2.5, 1.5) - -# Numbers at age by sex -N <- array(0, dim = c(n_years, n_ages, 2), dimnames = list(years, ages, names(M))) -for (s in 1:2) { - # Initial age structure - N[1, , s] <- 0.5 * exp(rec_dev[n_ages:1] - cumsum(c(0, rep(M[s] + 0.1, n_ages - 1)))) - for (y in 2:n_years) { - Z <- M[s] + F_year[y - 1] * sel_fishery_model - N[y, 1, s] <- 0.5 * exp(rec_dev[n_ages + y - 1]) - N[y, 2:n_ages, s] <- N[y - 1, 1:(n_ages - 1), s] * exp(-Z[1:(n_ages - 1)]) - N[y, n_ages, s] <- N[y, n_ages, s] + N[y - 1, n_ages, s] * exp(-Z[n_ages]) - } -} - -simulate_fleet <- function(fleet, yrs, sel_model, sel_true, n, theta) { - out <- list() - for (yr in yrs) { - y <- which(years == yr) - exp_model <- c(N[y, , "female"] * sel_model, N[y, , "male"] * sel_model) - exp_true <- c(N[y, , "female"] * sel_true, N[y, , "male"] * sel_true) - exp_model <- exp_model / sum(exp_model) - exp_true <- exp_true / sum(exp_true) - # Dirichlet-multinomial observation error - p <- stats::rgamma(length(exp_true), shape = theta * exp_true) - p <- p / sum(p) - obs <- as.vector(stats::rmultinom(1, n, p)) / n - out[[length(out) + 1]] <- data.frame( - comp_type = "age", - fleet = fleet, - year = yr, - sex = rep(c("female", "male"), each = n_ages), - bin = rep(ages, 2), - observed = obs, - expected = exp_model, - n = n - ) - } - do.call(rbind, out) -} - -example_comp_data <- rbind( - simulate_fleet("Fishery", years, sel_fishery_model, sel_fishery_true, n = 200, theta = 1000), - simulate_fleet("Survey", 2005:2020, sel_survey, sel_survey, n = 100, theta = 300) -) -example_comp_data <- tibble::as_tibble(example_comp_data) - -usethis::use_data(example_comp_data, overwrite = TRUE) diff --git a/data/bigskate_caal.rda b/data/bigskate_caal.rda new file mode 100644 index 0000000000000000000000000000000000000000..b96068292f1d46b95fc74abd521ea8d0488ae7c1 GIT binary patch literal 74176 zcmV(lK=i-;H+ooF0004LBHlIv03iV!0000G&sfaqyy@@$T>vQ&2UKVgRpfklJ zl5LXH8q+8Uu*G34G-w_*aZvphLXQqy#XEllPy5zGw>v#dts%sj&*D8WV@~@{!zuhQ z6Wre4#|a6?M-5FA+@;xkAS9>MM~KoukOwc@OK(4A8{_OmcY!Uq`12I zg(57RC|0^4Y2=QwDOArH1pZKhtM|k-$29m6%UcXJq_XN4@=v==l%w{jR@uLfh)G8> z=cfvsNSOh1CuZFcFo6yqm}Y-1m66)>l=!cH;IG*5QuIv7U@su;@Zg*DN8$cj5A#dM zaN9KfC=`Ej1f+kIN<9A6pU&^?16LU`Vz%}J$@*$0E{j+x5Ia~D4pk^5}>g;jwhEw07QmL`I<-ZlG+ zh7{Rn(Vy3jGWvA^iNy;3+cj4)FYl>z#?g|OUTv-(Y@KN=-Q494$JrU)zbP9nv}L#y zRP?c>k}6l%l_`SRvfR7M%P%+g6z64$s(KE+tt+s_pNpXcv-4IGeMZ+9PuM?!+zKJH%mN-y)3#0cks**#uN=WJP@v8q$x2 zPi!2xwVbRRz>)cUI|WK&#S{LyTph9$U5#=;;)zQCLp0fg8ohy5Upw9a$R@n?d)Q|I zthN6g0&8EU2>PP}|9JQZYXehzx+M_$}%z?09A(^ykXZYjX0|9HWY(e#Zr0_m` z0#+}T6pchEVGqA1dN(Vx22QiK6*eLfokv>_R+p~aA~&s4B4PKZZqX{&1G$oFUvNrw zgDAMvA}I_{nn%~u-GZaw-MK*gqjIjg7P*tutvFGX=0WcpR;RhE*For-z_g`_l`wcz zEZJ{{gZOLmZ~0@xa%Y>rEGWVhO|_RVOwp&z1r8AN{NYsY$@+KI8=?MxLOayB?lsvh zzAbfFKqQM zbC`{y9Pg(_12oIqw&c?j87w^!!`|4073myVNMQ)>%~jjp@}r`SNo?ILKx!J19^g5E zjgv^)?MjKQyXkvvE0>0Z2#D$a)~tJDBApXkqB94qnUCI}kKimUhGNLHwmS1J+!AMO zlO^Hb-VH|n0-YGHZ6jZ<9x6n`YxCkp&49<_+`gH&T@JLM zNV>->?YI1hjziS%mnJI?jn%2#JxHJQA+r!xgB){0a@^QlT*$|@hP<4)yfuzcXl$&L ztZkZllZyuIwtl4K04?cg_zJI^yqIJ`I3+JhEu}RGd5!2g+js}|XQvy@;X!>H%13Qp zuYO86PNCxKQN8%yjkN62nu+i*NYBewB3Q_YrJqiZb*M(tQF!lj7TG}K%yb&SYxi-= zNdnjyVrna*LTNs?=)*#I;sgEBXDTAda+t&sG+%1V^pdgLt~ba~-voFc-Et%~3JKS_rk@?l zzr*`Y0Up;RPS-m@CJEuunQQy}J6g(VLzf8gW?mYA=a|(xKG@-K$!7mceY(Uq9@kV7 z{Fbo>^btow<|t%B3>)XUEEGB4vBL6(8?(D$KZ&m6#P^NWK|t2G4Iuk#V&MCS4>R9vg#Af;IV&Ha{&p^~Ac*@=&@GUchI3H{k)icoheaQZSeoaSKlZpHQ+v~SJi1B!|6S*_9!k>_kA7@=yF zO=50WFihym05ht}6dS+6#imne()W={o_PImy@K8R^gkxU*O7Z%jY2DPz%#Nk>4D8_ zJO<}hdz_uA*P4aLbR>jwGy52A6$Op1z89v@oe_%73wY!h3d}yZ^0J}_^Z<$ zP>2T4u~-(K=+reiwG!43EI|`Ivh4`erGuLh-WNbIlAbIpzCFSGl}%vFDVkrBCq$ro zJB{YhvJIz2ULDEI%e<8ZbTfp>625hfwlum7WgGSQwZ1VauS!6r1FRD=L2EPWIR@db z(oH)FAmri0^5($iJ=sH|wPiFM^aXhnbSxDKZAiT7KApYQeTi8ilKeZ`pZZCx-BWN% zIA(#gR4D5zG18ePa_-5ZlF_jiQY0sFJr#HXw>)jnc?rgdHvuA~OEv!0A)cfOMLgEZ zZuDx&_U!RQ&owrUgekt!|(d`*HQ)vIK#kfHsWvRVoq_dq9=5UID75Ru6o z+OI`|gL+M1rA-e;cP1G$2I?T!A}Qu(KF{z#7fk&%CQ<$H;`=GWu3#G^f!PM)-Q8^p z;K&pyl{TyW3`uljh;$mjSdkw+bYCm$@wrw}3^H41B-o;VqblyAs_OYBi%<_|wV0@41qKC=}5o&j$V?Jwwwomy|{j_?oV0*u8@k!ywM#sd4IXxDB6{_h@O zNoxZj?-_{kvVMskEqxp-By;ftq%Kl}xGIeTRn51d{{TK+$dlriO{T3?Ga}ax>RRl% zks%ZL#iC805;r1hD@eZNwjGsY|YWxO!fTkbt0XPgT{-Kvd$PU&uxu{nWU zJUaF0GtIi{f>NRWQT1KoB23kZa#+T6Y|BiCxDcBA5_$U)*yiq3 z9Ua6S1ncgB?9~Skn|6N=o!Ip=$HANUSeS(;bgsVuy+y>Z9Wt4SHXKow&BB`?uu*X3 zf76B6U1o(Zm8{YgJnor&^Y0!}pz8QCMv_dU#0#HcG&pD!l)|1d74Ip1{=OB83U0bO z2(M&$LR~R*U8-X33ef%pW^o_(!MeKgZ9JZ;qi;H;)b3pPg&X(iLQ(-$Y~U-fCG4gE zFkjq{4wIQZpKpo?LLBdKeATkEVkR*omIh$yDdKcX0$MnsWECyHCYkztmYa`b-T>jI zRBUBJVC|NM8Ri6nktIT(ogO|0Dl4{c7Q(1RsbBW68dfsb`T`jq0QA%M%e)HNHeVXSdchIQvKx*+%g-P?^1<5P|4wX(8qcNTL6qA!In*Rwa6qmds5V?-+w_^{{ zOGAYF`Pnj@{p7Iwz`b^3XbJz-7;dL;n?v{6V+M)JuYpYQKoG%8)~5K(ei-Y+Gb~se zHm|YG*Wh3ll&c{oMdm@u&ALnyrbtiHTQ_ZeH*QC z?~${kI+prSs1cGw`k0A7R_?j41j3lJa@(2tG=z8{tJR-@&$T-18mGFo{i#1E-P5ZP z0%LY#t^U(55`;@7uTW?Hcj;IF3<~|FeTDBnQG;6nkW=gD9c7URJa)e4BT5W+&JI$` zqDHP#R*_T@r%}+h{1(1bfq-}q*KgM#-}!_wwjDT3hSoBF$60iG957rRZsT0YQdOn5 zY^+>Mv|X#$G0z;#+XB0GjBsQ~bCZi6DPtF$75HUm>o$L{7l&vr8}#1mWB|G84%aM0 zb}voMZ?N1r3Rc3(flD0&1whygPb$DtV^UkqK%0UiB?KD9i!pfR3~jSBMNF_awKz(P zax6E|+g#RnKkGiYoWpO9aNV&a==q}||ALd;Wg}`;{lE$jlVHV+#D&ei4+R$3WX&2F zo&FS!36bPiv)aL`Aa8k@!+6iKaz$UvX-c!(enj5ff@z)2eY|occ~Bxi>WS^730rTo z2%zg*<1k?g37rVt*z3(cSHSq1oyx&=vi41}b-%CTQ{^jixa_&3KxkUsD{sZYfER!} z57plIlCUiPCI;J3<7HMlKP1D?y2iHR;=(z1=ppsGExOw$14j(G&W;Weq>DsQ9kyk0 zBYoN1MLEY|!kc<>*9@pxBc1s}af_m@t;bc1Vdx_TNnqhgJGY8MUy)n3Q1@1+ajysHxIx%@yg>#%EU?EZgo91N^TbAw1lL^TLD~(*yBQ zzqG{8{o!&DK62WvtzXW#WS%NeLN!k%>??h67}3{i^}J~>lrfneJfbmWra!~)Wl(sA z`d;qZCQ`B;ZsOWMer%x^P}Sqoy<6nnES7V2={m`SD{-yk(>kDe-axBP8>X381=<$X z8SNpd42KlsVZUtuCxtmbK&`J zU81Rr(1OaTW+HRmdND3l+;pUl5rE2EVfB$hPx&?sLBVZ(X0cS&K9pOGUL0<}zPleV z<-hUjXa-Id(ILdMf5GebQ^M$XSs_=IYFcsto4ygEkGbdiup(79+Rb~#lK+hp{={9G zj}lpP5Jg@(2j|cR<6L@6xC2v_<2|!3qePP$%=^_k1cRVkDDPiTzba*5Pw6PAv!<`s z=52uGe#wS?ViuH2;_pQSX|LgVEdr7ti|{c=Rg)51u+4jrGd<00bl3>$!M;6!gXjo=bdMimMu7(uD%g!zQeGixT@(KmTUiS zajj@qMJ;TIa1!w*7GVF7FlyNRa5-rV639$P54Lfh)c>=|iZM%C^Map_xH+TW`|AZo z0WalkkNu;UW9t-{_7>o1iC^wcp}jML47JZMsO2>>%SN5cf7m0i?3fTfRBTH)hW-JK zAme^q=2p-E$v#ynS05Q;uQ-NKbgs53KL-1;v2zlF3Wkt%icJNMpy=nC5}u5$J{d|0 zJUtF)BI^d{_Wye`z?*JI*#QcH#p(^;<(dkCwpL1T!{#&o-5tDA#oCQS$i)btNMo22 zzn>O+Gnu5Cj%RC;YpkU>@MMm(d@SN3egM)Hc*aNiPsH|RQ>)|QK z+07~N6>x??_8zxzkJ6clL3s_p8?}>`B^6|$@RNUXajI>SN!m8JnNq%usxMz}vHcw9 z-&iqNJ0Z+fZf9&~^Vz;ol6;7nHq|_kk;mG^=xy4=g)|e!Hrx?^#A?mkLzD8aAnN(i zqIlAq5jErhiR~*KHpWJDIuSO?_@t+jitRZCiuw=X0}?+wT9`l?1CCO9@;Scr=*w{H zGbG4~@wnCy$3&iaQBwe1&1qn`vuCF-8dZ>CU@dLHiFLE)Gsc(-Tv-pl=y<>Tf%F_h zxI5%JRz)=|yooyIwFJjfUkI0?*3zgsM!@fvJng)q$^J?78K$E4Mq>pwA@7{FJF;m^ zou|=vzDMw^-T1Af?1tP3a{KY;jYp*p19vsnVS6GHfF%+SZ>iEfSlmZv>(nfapv|r9 zILjL{z&0n3=KRW29*!VA&D%unQC#aUzhO)@D!&3LASZ4boz#RewMmWRe*N6}PMQ)qjs~E3^V)57e(nyCPiw6$^+7A;!UYGHF*_>s z$Zc{BO_qSmnFpVlhb!)m>56R$U$@6onZ>VIMk0W!4IrbcfGO9ncINHn;|8nE9;Nk{ z7zri1@zPRb=NSq2#0^SYjHY>xPLQ^gz9iBUGfXu|g zk^PN~axz)tE!r>Bl22{C_Dt|%|6uS;Nx6JomO-qjNN72XEu4J?4>H-RkZf@78vtZPKvYH)d^uP770D(?dJ-hFQJ#fh&=^{9;ODt=}7 zDrum8w3vh^EPNuUv4cZ>gx(UgGsJh@1HC1tX zES!>z)&*2J@^ji3P!&M+VFUR0z6-$vQ6d+0m#cW!iAhRQVRx+&)U^@0`8m4n^cQy0 zGLV}L0Tju{n=(LVQ^^a#Mk~desiQ06ME0rTrns#qCG@)fy{2Q`4U@=^f~Efun*Tv? zGT@@G{uCoiYJr$o-F~`W7pB4s^6BDIq8CW+N_=DfP36G={1VTxNOepNWVvI5x)L?? zgx$%fKq{s?-;1k2TfoP{oF3*c1aIvQwrv)oF3D%F`ytGdh&@fWIjh@u9>2^4996{g z#H95$1F30R?JzMKbHR+?uz`TA?S3|f$_?m_vB)qPOhm{thlUPuT3)U9IQVw%rx(xO z+Mg}^448kLz9Bjy1=%gR3MLH3?1O|8&S%{g$9bAIyano1M#`Xt=&Gw>Y1QVeM6UYg zH3f$!q{C0r;^VIuPp)3mdF?JU{&7zyrs&iPZaf~%F9YRtEIMD=48s>iD7{Lh%?K{Y z1aA+^8F8}3QR&MhV;$}H4gUdl;R$AiMxW7DAgvvULS%;lmipU`Z>QXT`PAQc5)lQUpDx`>KqofbTCAosk;>aYsbiU*Fo*>}F z*d&v!k9cP^9ALga8WJF}l`{oC?~Dw38z2m;0pBH(q*K@Tqu@&3VBI!AoctY$(*3ki zT9K0C=MNDyU}6Dn#~eHpg?^m37XVn z{gvVH3h0*tIYnhr=vyq}vz^~1y2G5~LvY7ozXY~zlgQ+=*zgZQ^25qfDidZqC-B9U z5Nk%(K*znn;OB6!tnaH`MDA`qZl_y23U6WZQ6htb`(DS(qvPG9%Uw5%Yl1r_@%E+z zcf?_&Cc9>d1K24 zn{vIfeplOPW*tPI^Tq&2nigkH=)mn<%r%jdFSl;-`fqE9Po9bL)9HTFEU8A$yZ^@m z0QPoTqcmtZDGPV>fXoPRI`ikd!?_B}C_zj$qPUQ)YDV)`KIU=$^A(eD-$@_P$1-DH zJ$s##cw%iRM>);$E^n33d55tX`!+5HtvD>I$PuxwPrwlq z_t{lz=A1xFu^%zfI+AU5y`l-5X+9NK$HcW3aLU1w^aui1ldljXev3X2y7P_)Usx>kWMU{2Dsf*Pkl{2$=YG3srz_|kEL}iy|Szcg- zPWW!dfW-^A#cwZ{pYnhm?~rdSnE^6IKhkaL5dQ|P+@d#!5!J--%1d*ZKQEbD7|_cM zB%0OPNrkWJVm|I~ZdoR6FJZ_*+j@Cmj+p!xs5DT?(WN3+=kvqYl)J2L>;~Qs9eL0Xlzea>(&>=_BuSY}y;6=Y zXPW-qfgdQ8LHYPyF&Z;Y#oT@~&9XqFB2o&f9RLBnZc*mw#HxarEG0sAMpH}N3_+h| zht(&Z&cuyqvSh4bjDz?H6*((H6@P>y8gk01E$xZrODl!b_>L zas&3;iQ)`v_$r zbfLk=l`WK$LRpWN9^8nkCpMnF{fZaX^3Msg8`K%@zj# z_OzenrYZXXgK~OGXG7pUd8CT#Ox+%JDFQF5+|_dtc{crSRv1CMlO|-ej2USOR;|NY zLOjMqn`s9zhvWJTeU%gK;=IjK z_w6&=fNuF}c&xCh4Q7Rz()RQjfBowrHGme$VUVZ^)^CI*i&LaaE0<`dErI^;{^Pqn z&X(~4gAozvkf$}U*D&brQy{58f>E#UTdh!ln;$9LPz+serZ(NxlpA{`%Q z#xDcR`h5Q}z{aS`p#-rm?{Ea|m)ZiKzWi@g5eJ-!nb1qlRow-(yU8RC^sWTRrjPhz zhNG$lulR0mUb9DzhocXkv9nfeM|Lr*p}?AxN`$8Q*%)SF5#N!zQ-PqDGt8>%QGrlc zd`g}OH_i9-08Od7N-i7P(EN;J@k;;dOQDb2PpUkF-McH0Q;djk)Dpq>@Yd5~O!}O~ zyw-xS6fV^{(ila>4&b!t@yKlt0{~@T86R4ptv8h$HU9AFf4~>x78FQuvnY~(r=XCk zNf3xh*+b~m>t4gHrUO_eL01HX=RXm3!`+9oQ4BgD%fykPSv9#e<5($SQ{(^DNX9{1 z(HI9c!7?c^0Mnet`K^0;7|6C210c@c2Xed-iTNF&3;@}Is5)_~%KJ!?i?~8c3;uJq zIseT*Pd8Z`&`I!?L#KEt)CBNkXh@trJ1Pq5gO8W#N>)+D$t6w5_fz#p$Km+dc`9$k z(X79V*yVt2p<7CY?%vx^T4gQ-A_A9sRw)B%=#vXu2uD|kIa*X3MP}ruyEp2j>^u6Z z06|?Qyou~!3*t@)CkCz5=4w@PCVj%W z!yIn=dGQhyzN>%fnC0=0{@*JyuSLudDd>bSE}dgj15tm|r-*hi+t}Dx6ZqpUo^vkD507{beQvtRK_P#J z&%eW)&y1!UmcqI^Y`6cm zFj&Vu%b_eBh_?WtT6?*XpVjrT8Oty<&t?`(Ptba%m{k@94p`Cyn0Pj@IHZa?S7Znq zB>0B0fx)D|=kxPIa;FcFU3!?m;+V4tIvOy^jazARVDni3(+R3b#`ir1$&o_o;`sRq zqj_;5!0>G=un65~Db?slRRunnX@dwljKOO_p`#SS?wsBQQ!>C5-(cc%`4=0n4R+u) z`2@G2)2xDtFWgjkGWTs7Jj@%JxlEa(acfgNScIFH4yyl=!Y|Gn$34mU-<+d6Yc+mO z6bFM{3}SD0#FXaGrq~++7UW3(-fzH1$=X7`pzD;MuX3GY6*|VA9y7aEzC2NP&yX^z z*o3ISDbSPTzbH-f+k+c|D76Vw5}jMqn#Y}ouH_jJ>cqAaZLvOrdN&$ZQ)0{tCmN2zc=wM~?>QIN`XGap<- z53eMckP<&R?jgE>BIjV3jGe|7;(8EFLESt+>b8WYJR3!xu-^8&YMF>E$;><|iRyhV zD4CnkQfox3vZp#A1gNvQ5Pn9WW-1oE25%vh1cq8BmCPNvE}}>TS(kEsiK^(7TPa}R zq}l@jZa3Xt&nuU}EGB+pY!2w(*2@bv9$>*+Wgl1Uvdtof4zQFUpZ*yJD$~S7;8Z?n z08$GI!mK@Y;ulEd*uogWM4ouwx1jR1(4Gl8i*epJNa^{L1LXTxw<8hHsc$ceDbZ6HYUZ5i+#>C>H(N;@1(n zLA1D8=$;xojK5JXNhPm6!$BVBQYAfHZyxMDqa z8GnBw+`DebPTZ0$bExA;5ei`0MB|@eBQ8q=6mOi9Lr`@ma4BKFfo{+I_V3)ulRl0i zjKe7_kYgLpc2o_qj{N$@aYN`ZLfy9#;FbjEOKF1`+e zRDvC@JTpcUOYU<9(=8JX25VaX{};-Z?76(WKw_Z*_QORj?NP>5@Cqzrz(+E-&cHrg zR3afvP)ll@$&41qV`M-1_2W}$=ycT%9dT39>kIQ)IL>}Kd9DF%kGdvpn8@H|PVH5Y zN1#gMnAzt&(m?nwZhWBH)06eGl4le2DS6I0EVATW#>ZOr*;EMK!%3bZ)CF|e`xdyS z;)TirClquR)NGn{6$00#r7L*p8O}zvk zh9E#rqPX+(*BPd}wkXYYHwrTc6$dS?tz`^l@EI)S29I%8l17%)x*&yUu$J!30)X#w zN^oMxodY`>_qfkvArL)+(ML>^h!&0I_$&M=QwUWTUWLgI+xzfz<1bNVDV$%zqEJn) zu6AYf_l28-T7+efFUlH--U!VLmaNfnr?TG&mp|y`kQG9L6|*VQ9L;VR*j{NgdN?)2TqS3)rpsByb%pq?s~vWEpf{@keU)}z%3N*xnxrU>3Hv6XC|cAbW8mO$ET-;tc`DeW|(^qgPYH^GSgBdj#6N$~L|N z;F2S|qe4o0&Goo=ViZjmN9|zUiFB^AK;VuE@sxE_i2Jc1vClEEycqA{-sNSN7921S&z4{t zSv!YJPdn<)1?X;Z*7zwy=~!#?rOnN|g_0_~##KC7!c)M0jE zA6XhuR4BSM?RC+BvFhzKI!mfPl$p06?Ld>2?-3!Qs{b+}b!vLyX6%3YF$&!u5o9${ z1)gT?h@SyL)~I_-tn3LY8OK`Z^E>m#6&;d!qXSr%te}hIE6VF*`Hww&KOnsVM~p<#Cw&1k}n3y0%E~_A9SPT`8h8;hT3vt<$A3#Mn%xI7Yv6z@9?WMDl{RL zLkTqAGhXAaKK{x?)QvjPk1DA5=w4M2SDv&uKup1}5?>s_ATVp|G;CZa3k&;TCEz8P zeoUqIZEqh>+}=Q1oy<0j|3v1{mS%b+QQi`Zk#Rg^{W0FCZ9>1kM0!9G^~36RdU_2o zOZdJX%9L#a?|Y*<6f5*U`xtL7MTuzQWviOap;26XFR^_|wsTxk6>z{~cO9eKT5*CQ zuk+EdI|f0Z?YSM+=JcsaQtfW4OKdV1Jib;GzuvpdQ$v*a%$!H^5n<0qmB|Y_QrSC^ z0P7m`NK>KGM8ldSc@9RB?_+rRh|$uX57}HSEtFo3gl}He0^9bb&?&gcz#h~J#nKn^ z$NX^#Q*4eF>rn<;zRK)9eC)ImU3$Ara~4!HP@iQww0~LO2(9ab)&kD2UB7}UoV?q{V%L-b17_R0*KprzF} zuv^=(L5hdcG-b(CHaetY7mu30*;FNMPxPf+aM$-Mz%dj(Vzc?6Uod$a7CTZk{R6;1+d=^1yPwUV*YtbTDoGP|YZpB@TINsv!m z;Dw^QkW8BY=oPof!L!iAJt~owyJRgACE9ShXeN^BwtQl_^L;si$)WC_?UeJKPofeV z~l;v zdjOk(AXzJ^L8v3mFt~E66qHr&q28>rS4WVfrk&HTsBQV+5*0O1-zo;H25fox&9`yq zbrQ3I=5+LOCX`gaNsj1t?e5~)+h3)pOdZxeLg?irTFY_m_2|WsN_PMPS#3PF<3t^< zVDb(ZRYB-k`+?s~p)Ny?2ppNMKoq8kRMHumf%tCsgi)4z zh1X737$e=k$=UrspZl0YWnG87%*{`qt^=ACYW_|;_|>^Ffcp_Gytv-P&+*1`R=7Y! z<4qJJYZhM*Y#}ih&$jYa`V_YLGyluAwn%k(EJS#u<2XQKExF;GZpFW6Zf16$;+e^4H zf=6vD8x6J)Cm!?-;shJS z_ph-=PwpU~JmT3yOj)**!wFIW=GrNXFi6i+3SD=$u`u#*97q`W8X* zM=?j{)?u|0R@Rg5>YTOYAx8q&uOmq&GX^|HQZ*PCvAgmjJiJ6oj*8{kANE;K+^Tjv z+aQG{iQnkH7^-5D3NT{(CiH`W&^V0$ynpR%`|!35>t1f57)$4Tgbl4eBVE|PVIl*S zGt6j+M#2X;Z`(al_d$|WtVeh$%mpEH(&d76+jiK{nBZ#(UkAngM#H-(*?wOnawy^s z4?#5m9Kqt-Ik?F@>8sl?PX2|lrtj`++DUg}C?Ip;I8cE^_#bQPnNfwLX!fPv@Qw5s6 zmt2JCSIQXRdawyTP4AMPAhFajr$I1;+zwy*Q^(y&yD}64NRd*Tb$ANx#z$g;^8X1% z48XK-7*STXF12qn%zdtYZS^Z+aDT3@hIDgJ%t`y*Sxo>UUM56M!}aX6+XcPRFqKp_ z(7;`Y`5=)wiEwCABeT!GM|oTprg5XqF_qzmdKihr0uaX#WcojZY1H3PECTDSZ?&#J z*8@>a^4+8Z6_APW6_=kr`}I;q_m|6xlbiJ3FY++&8|m`;4a$lQi!Uo8AQ|_c+0p<+ ze-0lAp&*^e2US+@>Hl}+KLvKRzzPHjoDDLiMBoZ%Nw*GERS0MMbku-ISK!uwzGL6u zE%;BoPr{z?4%{#g;6%WEBr!0?nm_8m-~>l|+h{z&?9@$JnV3)e4fa+^^n#Y5SmnIi zH=R5f@65O5AhUpb>zyM)G!gUPxz>6|<^f_Bpq51MFRg#xzR6Q-rhyq!lxZppEf&Gf z#vvVR(Ix5OPf03`gAu4YuTn$L@-gKbmCu?Vt0k;%O$8MkYJE-%&Q=LvEme^h;Kp8Cp8qtdYUpMs3_-8%RE8W9nu~qIoX*KXfcI4Bt|xQ^U+?lDwO-Q>ts%DZqD=b z5xT#*HNG3TSIHvK@RxaKBwnoOT z1(0oJzzPh^Fc;`APEE?BXq)k858a6>u7edWIPc^GI{WlJt2v8jx#wyF{jXzBrc5AQ zEcPX4O%#wTlDhqYWAezSn-|vzsD$+UCMDJyslY`oIVjyb~=@YO`OB5bd_m~6~iiU&hix`_-yiM?=oTF@I|;$ z40v_?;1bhu&puGPwCriQ;k}v1=*OVnRiv=hB?p79E5`t{O>;YCO&Q2}2HYD+MM{XQ z!mC%@X9!dvn^V9Gf1q8RGF;~VUh9)FjKK&TF)M4>j%xVTh;Q%O|yoUlv!7I2&gNx7kyXrZpdzG zF0$6N<-sESvnZ1R*=IFCukhE@$F;Ui&+L^pR9rv#yA0bVRl0Zzq5lp=TM5Lxw-YM| zRwg478QZtSk~`sL37+=zCJH^SbAErNQsI0jA+_Is+8=||qa&Y~$v^iaWHYkPe@WiE ze3X{;XnB|kjWr$0v}ZeV1i9mT0pz{uSl-K{t6V;*3vlk$$!8sCq?a(z`9y{J4; zh6t<=)QXomt`I&}7A?S)$gzC9zIe^M8peal->mOpbit=GSA zX*+W214J-BwoDN=3bTTC!r^f7t}c?&_k$0gK4f!!j^Sm=o(a>ms4>;Uu)M7X1C|d$ z&$G{+HNv)|XpzTx?5}!Y&v>l=FwL~ygoQPk%SG!)ll^726{=p5)@d znOlL~!|=3NC4r^{^0;{xrg3(*VA_qA$l6OU5wKl^eAIryaucjJl?8r>tU%{y;N~v@ zZj2-b*hTw!5)qUVRFlN>8%mw`VLSxv0-a4r3P{J*$+<7tDBpMchI(;cR&Z6s%B1I?$&pqiT0Gy-}E6 zPv?JG#4l8>(x9g&w5b!I(6&+`#1iCvBDs^?r1oPAOZV*wcJd|htHPte%s`4qjy;n7 zImy@;aS1~wJT6Ca;Kddg)ZDrw=ZX=9?X^=TBI@@w<2XdP!c#ezp(_7hLb^$nqv7cy z=ECFS|kFPj5L3YsTRgJxgD4!fw=ed4` zSE}D^(pa~h59(HUXJ8nLYG`xmqpeahwm%f~XeM{Bm_i#aB202{kpYyTv9||(AjZJP z+kVt==AS5*yY8X+4+1Nz6wztsHWaPVX=Cw#LZvklj+5vjH-Fhm$b!4 zHidIh7c&Lh52|jo3Tx(F>h|79`|!cBUXWz9QqD%7hiW55K9@6PaOy&0XM)X}1A*N( zM)tKHgA7INcUito8azm?=I7q8o=TMZ+E4z+2~G4VWV`d_XLc)Ha1+@*+LDVRpZAv* zK=**Y_}KP%ogJ`G9W{vAm%W~$(PqgDs6rhCvg8ilwjYm%c1qyGVx<+u<}X}_O%=_AQK6{ zd0kiM+D&bVkgy3*HXQLXSg@10H7^A6wgWUm|CSd0o9vNAbG=?-pBJ+8rh+i<6LyS~ zXE-t58cyGA9hv(zUCZ9)k~g&^$}r&5wK%LIdlAL~&5Z)ESJ!;@Ld?Svz&Kasbb z)Fw$i`cR+;XHwpOi~{S}{A*Tng~4+aYO9S*tdURgSfIu@ib&YFNULa)nO`M6+1V)4 z2*f=OxW;L%0XsthUm^!LF3cwwiEW2=)M(dgK%)&#cROl0;G#?e=slL*9`lnQ-ab}x z^S*9k*?P;PoURZjqm2YKBK~1SvjqygS7C5Erjs-2XtPL+!ZJSzbSN_KehzVZQ3@;7 zs2_aCn%tE3vBSZPWW&>j6Ly+pIK{R1c2U%(iW5Jj&7@aX=}aYC#E^{l3xTLP9bwg} zu`80KR+`us8yl-M1{hkR-m+piGH)f1ApV&utgkmTOA@`XV0D^m>eIcW`jw~_rRUV{ zw2SB~%WYd>Ns=4CEC*7uyp|NNZak1Y`;O7s@Am{VGJMGIl-Yw?VpSW)+s6#+U==2j zpJt;hN)_jPd_U{Sr`xS-BfV^+mUf+MX}til;7p8X-CCiI`^I^Fd!%q~j06{6b^+m| zt#l$Gr0~`VgE#`0+iA0Sham2bt`<*ZfU;Q2E!gWxbXLsYso7 zq!zmq$14C$^wvOQz>ZiQ|Ip zMU%c48e-ru$@Km;)Ai-sg5el^mtuw@w#DMI=X>5Cg*@s(pFJlS{K4BF z(+NSr0t4SZG&E|#pb#3V_A>Ge_m&prPfFxPaTe!@pg^?m@iv>1?!}v!H8$UYU(-{H z5%5knkU_KhheXAvyX^|-cj?y!F>ubuX$oFA5~bI8y*@psd(fpXi!CiLw;T7-Mi9>rKQaB1AseeuHLZ}>DzOW0KlXWt6-{ZlPJB_K} zD@^DMi2t$|nbrd)x$N4`U}wMg^H7IR5Mi!pS$_)-b*@V7_|vSrn}$M6N-}Ic4=2NL zJ@H!tUVU6jt0|twmSjZalU%C=(r1rgI8sr~SqS+TWM7-ucsp`u_dy_oxHvuW_PcgB7hEqJT~CWz8X z4uHSE==OY(hif(iAs6?AwiYAyiFeX}eS~vcH`Kps6RiOB`nVWrKXHa&ZTA>L(_ zjLr9^N`lwoMF*(##MalJfW98of)*^@=X`h8emg==9w8VN>a?Qwg9}}y!+7aOJGpLV z5sYmIi9*bAfi7n0MkNV^bLkwa*^CVvxN-~-M#Z-yuHlg4Sw$Q}qaJ_xeekQt% z1X)L2`%g3G4)*lG)f*PxWU%$@MHkiY_*_{5YnLx>~PA6&&V1a(yV_~$>r0^ekB63hnKPPGV+nkq^%h7WGQ zTiSE_0iAz%d756evA)@Eg+Zb(&aX3^C=2hC=qfqEW3S0dI?JxA&l-msRz9=#9nR+E zD;t|frT>SliX6zDm}*s~oqUwQ;6{|OJMp%ow5_N#=Dd`+5*RHvc~VnC77LR5hRt;R z@Ckj`l90dUA7Eud;B%yn95P1)14Y|py;<89e&eZv559{ZNa(QBKR{qJ)jaY1 z-BC4&VylN^B%-Od{aJDxzh!^+tmZr{A;E!4civPkbMH}vVJxv~uh07LYd?d6Sd6od z7B8aKxCSOQ{S3}Rw5gN!P`!+^8<=tM!gexd8SLoIz$iI9Kj_I(=u!RUT* zzU-uY<%t1@V@P0m%aT^6mRKzTA2rxxPGU0JML z(IFHsSv3f$F4$+w;k;DP{B^ti|Kn{Bjnu}x|Frgjy(TG!#Pmy*A-fZgc`+qh^>|f! zUv&twjXV(QC2^HeZ$Ck6RhOImL`py)4?LajjMEOla^MO5VZ&_3T4qn4n%6m!T(gJ& zZ+8sexXTggd#+V{Y!{XL@&BAY(g^++Z_1n9Ex}XP_0MG~@{i%*VZ@WIOK?~@SBW|8 zNt#&@vA`DYt7xWnu!LDK!)~tbabR6&X=z{C`MQ}K4GSgQ5g<0pnQd!WbOA$lOtxS~ zKq{lv4x{O9(M=zkSt6{fT0mx4xJfLt!Ld?(b+`~Dn;(I9)>Wgby;EZ@Wp`41T7nqE zUpEjZd4(N#(>3o(u&9~4NZq-H5-R{ZK*YcEauezzf;eZCF>-cDHE&II<7DN$j{R@n zK2Gx4oP+Uco)aM-kn)=r+lKzkw7L2F`|Wy4i&c<=qhd)DA&$(RDLp_^e!}kzNMxn@ z5*J}r^j4;GR&`L!{Aydj4$b&?B@>ha)MDHaS+Q?O#PP>x7z}!Zet1+dKyS?hWcMhL z_xZ3mYO}#M0a(QKETUP_p};ny`}$pnif*!Kp{MC508o$G^yiyfyH91TU~lrR{<|+? zC5D$YK;qkQojXcAYSL;QgGR0y;`Y1E>eU7trEKyH|(f-!1E>HgO!FsQ!1-VX1M<1X(G4$U z?z{4)QrTNOd|_;!2tVuV3^vTk%{MY({2CC7_R+cHB8kc^lcgSWBAC==qRL_?-Sl<& zNoS|Kr=sE!!$W?_(&&@^E8hk%Cic9oWGEFQnJ}+51u60a6Nj0?`BLOnTa1j&;En_u zvP!Q=Edw`KxeoGeN-}48Me7F`CpD#Mg~TA``g-{+WTtO{=r$@cl&?3!&a+RZqFsQ|aKTB%f6_9rbWMy+73)a9AVxTdxt7sh5KdGe3b znY#x^cPMajH;(Y`Av`=Z>j0clcib=03@Qv7ZL`M0!qZU=X=oIBaukb=uPZwz8_*C! zSrfI&-OhuhX)6&ffOB^ttGV={5r&@3jp_LO^=6oL>b^u`&4UhugZUvLW%;%eVFh_m ztGl;|-p1fl_H`*mO3#e(oBx^&_acwXN}V_DnX;R#@J6lANj>mOki+02Y@lK)tV zOplvh96*<4d+`cvJfv@bsL;yZN|9jG)O>jo>A#i!gT8<|SYY=b5u*C%Sh?QpsLb)4 z;4F4xp2uMug0j1mU%72Sf}rmEI&;&I3@Ty{av7ci4llQWI!}Wlwyf)D-1#jU__Hu& z&j>UXJ&3K+g3QQADHgo)w4Eh_ve)6t&(1D2(8Y^0IKB7eeh+wJ2IYm&5`(QV+g0_^ zNE5{KqyN9ZlUpu5_flt+e~ttHFuq$*BKmU&r;jtP)$By6d$U4klLZjCIrGD+b+!ly z+Z$NG{!&1<%oN(=;-%W)@?v0&3-_eV`vLMe8+-CA$93vQN4J_SrU~*SBg3Pyo9d$I zjW%uL5Kz8YuWURLGU2runv@^s_)8ULPHuxb!Poghx2}NxjW|{QcRsGn@Y3<#T@a(E?udyRa9V)Q!?oJ@}52Db8&&Hf@J$iY0<<*7>YR zg!f|2geQfB0Ovs#Z|NxY>1(=9_$FhAAS1<%K+(Jks5UpA%1UC|xB$6C@0#Y;t$NcKJg5$fv~vIM19(h^^(_MxVW$MbQ)G01F8+_Yqlp0zu!!Ov{t~KQ>(*9 z0-A?7lJKHi=c!v62c#5KX{-|{0C#Rg>uWb39H(n*W{@ub*8aA=6v*;Tr%9N!{>G5H_AR1 z#roSPl%0XN=$#?VjF{nGlup{xk~!u!{Bb4ldX57TjPq1pSzE%B6lA#sF{XD7`TqN@ zJOxB(0I{Fx{+R|$(qn^fesiAF)BNiBeh_!cnhy{q0ZY&3MygJI6T$domWF2gx>1OO zs1!$66$>}^s=ONUCba##1oH@<;^~?LfDslL$-g6mYF zr~N>-;Qv|$UT~I2pvA_Q)>^jJ9XBpTWZshWyy|9hPO5s!?asDU7PZjr8}nkP&4tAj z!mh(-$P+^eR5cZ@`iU+*oosEjlyudJ!Ao`L8iVL(oojjYjbd{VV8Kmc`Qj1%- z-iCB+Z?NlBIS=TeLvtTte_h4rR;$>-WI$Ro+h7OMHZN(W%s53;F9)3~72yi%udpej z7FXtW;~E@cmQQMlhbF842l?!%eAqnLvd$hK zA77ohuqK=f4;`VOiK6mgtNFz$1+!c=ZweXaeEzp0}3kET>qZK^3V>^6z0ZrEnmKu!C+Eo?DFd$$yBl)oQ$Epm_Is&Q)5f3)G%RJ(-DG}FIS}F?%?kv+|7oM$EaY?_*X%|Uz2CWYFa5b8;Fjy zkbz3O0{!`}3G6^J8hXu=Qs7OuAfB#9ut?Y1~IcBkXr7nAy$tME4-|B|6lgV$+RUJ3;I zm6|*zIEso3yn#BgnqO^!%L%N`Hn>B$-ky@h66YU>?o0@3j70Z>lFw8%ceXe1&D2d~ z4I<%8o*%%e6Z6-;->02z7s}pp33iQL=9^PP`dA6mR(x_QrUMSfEy3ezBZ4ELf0L7R z@FkfmVe92(AU=|*cLm667cOZ!(s26`D^hFqI9<=&(yecu1M~T#Y<1qtL;(8AYin(D=BEp#f8po8P^Q(&eL4dmYf`f8;()L?IO=@f?2h{EJfBJiKcUpO|x}` zCMbSqpUU}$r;L|^6lbIN?v`?deJvCKx5DcgR%c?dacSOk)wU>}Z6R}p&BV`giyya` z$(K?{fnFso)+2SZ>{H{y#W68$dqiDxAd^KZUcL2_3LMSU7Oa*ertPja#IK8WR$O15 z+MSd^XM!h_A-1$B=ZGR^hW#Qe;b^TmFvnW~Zodcj#o<2-vBR|^8ZYRTzcE^97b9I-;BMil5iCyl zA&b-ArPo(H=F614tmmr9M3-_1OB_e3yv_c9sKAjLr*h>pnNBc5Vub_Rwon4)QTRh} z&lZr-PeS^(9Qy@lh(+TMPCr{VP-w$`g6IEPhcHi7$X|UTG{?+^w8cv~fP)CaYGKB^ z%mYCLfPih_wDy{gnv{~AQhuY2yJ)P5dfClMK-*I$%v^!#51YEt`?=E#$0sFfO~u@& zi?;+3+?M2Ce|k?tK3uv>+?u9*d;e&m7ZH!(PW?b7 z!SCW(30u#}BOTj_$tS^{*^%`Vgo2_Ttq+Rgws2d?@fT5P-^;R#n15uPGP^|Htponb z)1(9r1`7|=@^JNY!tSwdWt8?2RUwg=uUm@I+#I18BOD1BgfznLY)C^{#_aXbGL2LV z(f+0*`37K*<@#2B?#NC>K=tLb^V&QCz5Hm5LPzORW^^r_HWvwJ3Clr!R6~O!RPKf$}$zBjKARg6z((G2Pt+{kKQ(m)%c){; zK1gAZEN0f^TY^1RHiAX7TX;K=L&HjYeFj@CD#5w44QNP4yn#`hqf?;HUD(#))tY+h zn?)&aIiBOC+J{&87dO`#AK3G?zJH2i>TD_I*E4>DgNM2sFc8*?pAK?I=)S+{9iR`V z#v|0qnqPlKBYMk_G&cguaLRob8=Z<^pq+KXtjNx=EX2k6M6{59oBvQY=#Ru?1z7-{ zrkFEX$aF{agQQH*(TeI3D|BA}!eSKcB8@`q4!h&XQ=|KKs#MHL4Xk2-5^uT11+u3^ zsfL&@*T?nu0+3*eq8WW|N+VB;4+meG+TlRn=ug~{g-kA?ZGx&64FLX%m)wgR2$0Sd zqHTU>Uh_{?=7Pb=RKsmaPhM**v%9Xzscxqk^2CU_G?+_~#Vh&*jn&&ZjcUnb10G)0 zPN>H@#3_7~C-g!*j+o}(0VN^(m>932^*VM3sf(x6qoB7WCdz>XoAocAtDm-en>dI7 zcs~|Qz#SHr;FUoOd)*(N9VGE58rd7M855vWBhn7n}NHG*{hj>OO~mXX@TH8T_Hp_pc)*lR|zn?(d$SVVAn~ zo{=vi1bS>Q!pz&$K|+_c?V%(WT_bm(m>|?Ba){2#c@uQltO4L3DB_&#-->|3mJu5# zKmYZul6crvSj-R(Og9?*?DO%X*7BzJXrEOgujsUDw)9{hHL13YNAHNpE`!EKzSa(> zXnt?Rx4+@@=`?L;O%xYj4Kk)JT$MzUVzl9zd%^D#pOw_9h_q0vH1rouhuheD|H#G5 z+X%Ux+2!TpVy|+V5#W;-aL<`{D>q*|HAQD?{st(%eD;)BK2yK_1@%S<(c_NsV$qvF zpUi1dmIdt~z{ldeHu?yt47Hx>N=8Ejg)s8IPJkO@ok z$exyEz~OA^+mz*yOa5n6O<-RCAyy=SRh%$5G+Ek&i&s3F=H#JnA409KXvWFA^Sl8G zQsroVLal44GybN2&{&0#=3WlLGKnYq&&>lZVxM;&rphcsosLNrbu-B{Mgw4 z5jrX(`E)VvI4PaQJlZnif}Js$(~bFuYnKljBqrV-A3^OL>doVmZ^ z24e3GhAtO9E6=e{*~eoWV8dquR$TqVPq>n`c4SGTipf05{#JjAFL1k1a_N35&DtJ~ z@{hgBT+C)e(izwfpQaxPI#4@Ycm?F@N|vnGt~j02rGx;={~FNV@Is{7cZWvj7DS6o zt>s*rLEK;QG}i!aiP+2b_^I+KliZ~PHYi$tirC*usvvwX}iI_RMTHiQL9+9VIHE=?Gb?Ghzx$&>Blt+a&or3<6*5W(ncDURY~Q z511Bfg%AlI2sVo!`LOJX=0x@^_X6-SxM5#;esw$i_fWp;CnhMemeD?bWL%mo%@e1S zbh(^dmuowi-}ISCH4AAa*#AlfKf54S<33h6Je0*{LFRdRb-C)b09@@o0UL5$efBu; zC1|2nKeX7wx~WHbBV25bO?Mg7aknpn>&0y!_VNq18lc_%G`vLa@yVnBMI?@wb$NkPx%g5LNUe%jPUg;s*eOaUXGUbTUBD4j>{kgN7wJ1Q9^FBUB zEsqwO0&`t{UHzxYIKKn4K?nj>CI7iOt42k>dk|l(IWrJDNOE!vfbCyt>PQdWy!xOj z(h$lx*c1l&l#ho4ediC=AL6sbnCOku08pq3_uqTFvl0pz-2)ytKuH#DqTJ;U#N#7a z3ibi{pizbS%0yk?py|}I`@ua=>#t-56(X3QJ7wYZ47)fCNW`RY)8X&V}?I#1>@K zGIOU~9!}N_(iI}k{WO0>noBKHXih|b&mP$6Cu0}e{9 zY*H|{EM@8NoKgt^S*0?lywmfVY7gDIE8sjA@z4(yZ9N7qaj76*9(9LkBp;y@Tb)wN zXgzHy@%ZL?sb#YvZi+v-8uOoxm}YKIf#25ymke9DS@4Hzke8e-=t5FJTpvIkOI?+S zYGf`rKxm{AS)+=M6HHbv&A{pX5?xZmaS>uyq+#~-WH{}U#=)OBSt7P$Qo%RG{WW#Q z-6-T7!95&lx0t4Ho!U_KJzg2sKJ2_9-{Ra5Gh3iZjh?2wTq$24)cfXQ0o3WL@0>up z0bD6R!?_vSfKNvz1bF3=<=00~fXU99xsSfEckY5|5-3X+ElAv2bHAd1ZxDA7CiWg- zUhlE?F}dr3Xum2+{MHYFQKQ3F9c!l>ueX&N#QEG6hUMF&`}-?0gbS-2TI(ks*jreS z1cVpz?RBGwLjzg{-GM`dIfJ`FFi_ma#u_@p_I$5R$FA|%|6gG0#uLe1b%%>??u{HK z$dHB{BRI(eC!^GHIB3ItCG2Coe1Xw@@3RlUxpp?sgvppa2;h8RPT%oeHih2liOyWg zUY#fT4R>r%4D+cm!Vaxy?e8e}cwH{Z4ypfsF)&&|#y3{a#!tD0Wi#sCM59W^+$c`@ z6Pqe&u!vJ;06P|`xhD1M0{1f-bf3_z^}{2OFNq=^Psa(Y_KGpSls@`xRHO)NZALMb-{bFIB&d+;4ot8d-4^KQiC5tNbKb4 zQEYfwES$5~uOWZMx3WDiAXGqYrAS3Sf~-M{7K6J3-+`HQj)YH+ArKu$Rv$qG_Xn+O zt(M$AYo@Tnr6lcf`sIV^9P#1goGrz3z#rCh=(%u<1`~`+Tc|pU`LUP0*6u2Qnvt6S z27n>YD^GE1ej59JvtOFNzjEg_*}9nRw2wYs@L zHQF1T=5<&jZ{r!5l2k61=Dh^B4y1{ndiA|&u zrc~c5HID?QMVR+oO>}384{^9REy{D(=lDWJLm)Bi?&kO06;U~0bEUD*BbTq1c+~y_ z-@yni+8JfbD2P^1s5)7^aWjkFfkOUMQUb9xlUBzW?ocf`LKE<$Y!?&RMjBGtsM!tk ze`|e7ak3AKzM`~ZutqZtk*hlqTFK#KXw-vgi&U@U=tqp`WVp|(&IOq}Wi zA`csSrm*AG>bi0FB_99Q)xo-Baod4HO-6Vg6s;ug*n%KRPnd%D%=gc#gE}P_C)~w& zC9pI%*bY%t+GfZPq_WKh@q^DEVYEd9Ub@wz)(M9yfQ`+nMn4c2lNfpCG0kA=^D3p27*NGHJ^*1_{d^{IWr6-; zuGYiYf;<)yrZby+W9Zi46#Vzhpqu}KirZ5*am3O%r5S1klOZ6%djR!x@%@DHWLMNQW~- z7X(e3-EFig?N}p(P9S3InB7O6a-)o$KIjF z3(7P(t+)QBvJ_a`gAoD@x1T&h;uJRHh|aMSVG+$@0-Qk}z5r4#pK+e7jT13p8wF%n zl6Ef3WsX^{6KkFHK3SYR&m!hb%Rj+IX(LIc%nBqiTRgeHHMG0%cK9hds14x~fxJej z$U{q~I_B{o%ECOfwk6C5G-(!jP(W6{P3P)D7hi$cv}?oR3y$vzDnNHr*Df5Khn?n& z`$(B1RHZ#N6@Cir7T2svS$J++(Kt)ROvLh6XG?yPbqyL0{>oOSj92w)p_@-o@I6{W zK=!UdV>7Jlm?ZGp)P;UI%G&q5>vGws@y(Mrc<89(hln=4J_#(o|+6y!pwf zp(v*r0}0gl)hyWKDK_iJu_wZ))V(a8aW0c+~fLi(C9er_6Gu`zp zzkW%K*of6v^B*@WW)P%LHQ5>Gr-yL~#bXWW&dhwls$YO>Pc`FVmV#;nO^WnWM{5#n3Fhd6u<$ggyGM@fX zPmA1%BwP8?D^@s`cbJ;-{d;XgCuz|WV#`kIcEGtz3A9_vY^suR+ia)Bvrr*st-m8 z3n0r0du^NRb>Gb4lrr7pH8 zJ?C*3fEjDG4&Ru=Nh_WgSsw1Vs( zR`LudCZgdBQhD~pvik{yewKz`~@obgAmY!Rma1RK8Z@Bl;0)sGgRo+hk+!5vi8q~C)oNv0-WrD;Il zfLnOFVa|%mn+X4!IJm7EU^ncK2H%K2<>768GS6zFOO{L(YbdwRUuJS8w>r_lupAAu zM_Y79`iJ;8DEC+PK9rF#4&CmEOn0Cse%{X`!@2lpW(K91CWOy@a74B+njr5H_HTWB~g9aedSVZ^`JcHn?bh5v%`??rUh z$e60z1kwDxl>j4sj%n($d=LQx6`Agot=UmgL#v^Go8ji}1_zTb$DYmUIgSxLD*V`e zD)afVzed>|gcchAk9i(<%Kk6M(GD#DwkdiNFiqSIdEVgyuoj%0o@JTSPA@PQb9hhr zW|_paZ8FGiI>Yd7KExuay#MHmJYSvfRrS^f)cK7Ys&8cbGsVR>9Gqj64Z_{d+P+t}VF@D@_`xh`VxV zxS5jxTnv5>?R6@NYlI-45dExmJeETws8qlS!qAoN``wvpP~ zw`p1t942e%KhGa5FwbnMI!$lGhx&$)P>a|HiZFnMl>5kL-uZ^+fO$WAr=B2XG+-=9q zt~5x7b>|I_$&CmM2Xg()F)VOu(CRpb;2T1>OfwpALD3XzL z2>l{H&`N-Oi(73f{hs!oM`&3`P|0|2_9V<974kJd^$?k6%E0bzW^&u-73T|>ODy76 zS}i>X;uwBMFUE>tvQW>MtuZr%o!+tsGKvHNo%LdOvOAg#*$I0=Jx`4 z2XzU#U$mx4zT_2f0!I_+h~|`!WjVL5-Q%2Y&9kIv`mJ&7ot~W%@JtyyX3`|^`+9?m z6yjlyR)h<_?z?Y0orWc06xH-BbSlw2z&vv&RhEW1n;<|@Pz35lA_6J~o~Rf<0yE2} z!w2ev5K+`2I~u`k;RJ;AH|s04#*(swn`!Qp^RLAcEQdzHg`I(-y$p^feuo)696n#*ZvQlLZaqQ&YljnmTMU|5%|tUojbf=uL&=sAsZw!&;`@ ze(&hSYpzvk#{ganl2QPZkgsfCg>GBigg_8)k}I1cL9DSMsrOI`;EaYh>%uPE8GMa^ zo2Z{3oZDrit-|vt4N7_0toyZL#gh7wLZ5v86Xl2I2oC}**#9CNE8Y8%Uyc-;TkYxd zRM3UYxPWX>s5)y38ckf`Cj0M#3S-k=lM7DU!{R^H!_5~_Z~l`jm2OawI$uXcvA3@< z3aS-b$|FntXSTuf4{R`I{baAUq-?`h7d>vt;t567l6AGa7N=~Md8`xuL6g9_7u6L& zFR!ww@SH}ttXQy?L%$g%mhDf{G{|gOp|th(sRLdEePmXDU<6qt zdWA>A%JM6s%Pxe#RY#zIVT$V~Wr7rmjAZF#{82O1!QCvp_iYk2pXe=cy#3b|AOYZ+ zdkh>!mFCxr&2Xu0E$nfkH4l&(^M(S&|0T!{sbnn|Nk^*sFWC<1vS~5guQM+aIMu*- z+JcYd3DhoZwW-^>lXxWN&Q$MiRM>cbG?ZB39Mp_@m#VQfu>V~7$3gd6T{ai%=d@58 z(;(S@v-5cMmPQwZ(SC&F^Q)->;k~;OcvIz3xk_`}K7&TUya7?{C-Tn zt=HZZ1N?*&b5DqrOu9Bg8=-{Kug^DltcN7^QD(`?z4o{y`detz*NnO4m?McMj@*PA zB@NWQ4IW7}eab1eg>cOK^>tUy&r;Nf%Yt&{0Lc1Nd4}D8(Cu}-5@0*7wT-?8uB?4K zZ=*@Baw>JLTU}EaCa9fw-6j3qLE4>Zir;Us)5Cn2gGBb`vLj?e)a-Q6^?L)y#=2Az z)*fb1e}8%3)ht@cmV);qGg(rip-`)A5h-ejbBK+>!hJ-f7B$mx*7Bwpi&=zX6R1MI z+Bq^Vkn`qYrkVp<J;h6Q8(kA-8or$V>&Be@nesPu=_=v#q#_}_pFmvb{8R{dZ+goIfHg2{myWveMQn2B2r)2@>7Snvd zA|!u^S3J86|7jjyw5L3gq|uOp8?|k(Tj-|X$iT0!z7{^|yMt!=m+lT!8`Fk#&jyS& zQ2K`^=8w-koPRh_TRKoo20q`%UCXn0DK_TbUHp;RO)#%rgcO&|9#o}PE{M}danaR{ zdrxnz=jtHwgY8PQUctssW6TOO`yv2+9_}_Oaew1V8)+0zNf|z!%7Sj6kU>q4M4dGk zG^u81^nI+bFOAE~=sN}2Q@2T_1kZ>(qc2_nlu*LhSI$w|PBwZYo%##-va5L$dZrY@ zLbN>ZUe7F}q@~_t(<52&x~*K50c^Y1TOW*cJu$%3fwh=Vb{h>Pm50mui}NGigM+sv zxm^>X$SUG%i5%HGVOl-*Ere`Oje-n<&$V1^73S~xdQIMDi4_ocB=R1Tx-JGttJbf$ITOOUU>3Z*^ zlC=Ditp_zZjT!T&1S#`Fm*w81F|`sWZmXshuivGIXaK%$2#3+2c>h;{HK97Pe zhmPWX8)Fibfo85Gr9|Yn!e7e_tj)&M8+@t;q(EY;y;qSF4TUOAH@7oQ3nxDKRrR#L zCWZ3O_iPcbf-$DW?3sLucf!^Ds;$AQB1E{TWO36*H6SWDO)U?+BhBA{f4|+pY@nVn z4UD(cjo#5YDHh)0K$sgyz+3+H@yX|!uT~PRsng9wxlri0P~7#4#nJZSwfGW((ivhO z2;;s0iIN5Vtsg=ZboD(4K>I^N6&nHumoP6uF{HTLYJMp6z3<n6yg#_OpfGVG-~pOO{0M>rE}_>ATgIXrX`Sr3)F&8l zIEk!+&>1#UlqsZnEnX+!A(?ZRo)w_Yy&h?^gDipcIg%L2pDyTA6!@{4W(VJ^Y~Y{3 zhU)g2SNcPz@jy!8_Y0)R%7a|F!_+17oDU;=l;lo!UK2`Wi*gh`6xy<%CHn!(cRgLY zt92=#a5|fa{yrR^CM!HQ@xr2)7aPK8z5^VwIV!09>KJpvn@VZ;u=2pC`KE6!rIRWl zSfvozDLrMu5MN8XYfCaxi|ODD#X?&X^XLw*x^O7>lAR>R{FH%$SRcJUN^(r|{K#&G zxfgXTA5O_tmK=-{)ee>&`qwG-+Bsd5QW5zoo&IPBY*v#oUhjLe4iX=T@v~{V5R=#z zQ6D=BUOG*m<0=p+q+Va-y}Miprpw-X8x-hj!pWv5jnjQL+bLoq2+yIBpa21tY@qig ztvI?Xl@x}GX1=D4P4wFdJ3~-MV&pK*CU~7fL&7g~#~u=e*C}a>qiAEtO(zzmm#w*| zvpya@cY_1^|N7wuhCj@nzA^R zN6hYO0{lq4S4oziW{&}Amj3JnCFmh(Toen_nxy0?CP^@lQ?oaXwF6<~Wu-c>q1;8NN674Yp0nR?T&CE9wu?%e>XsA%o~6DI5_BR&u0d&9ceTr!aF~CE0HvN9Hoy8i zOG}7WONu^7&R#5i`@-#_lj0^#Iiq0#yUWLqqENJ=V!Q6Z>$D=3rM&On`uK;%HxMM6 zBWIB_b>4`Kn@6w&agCmAlowIEd`d0|vS-!g%>seOuExAQ4QTbwNKtr%=_S&6@%UIy3ydP z!Z)RaFUSbv#$&%JyS`9dGrrO+NixpCDyp!Q8*4~h^o~D>OBDhVZn)XYGrtlDJVU82 zD3=%58HDe$(<(pI;}@qtl7s3C%v+0l-G4(`-H$7c0$UVJW@>m^`0?fqcV&(66kiy+ z3S|b?D|&6^;{LtPb>9<%VAIwk{-BEH;TvX zXS%er1A$r>`xxT9`B%Ys-@`!rOI#NDjfN0s$%ZWE6R5zu*1~7z^g#n6fWzVvmV@RR zz{ww~?juq@e4(cGG3ICyCYMAm-h)vy+r(XPquzJjCR2`(vCC$iOa-tz{{Q@NtN-UA znwSKSa4Vi>fM?2fGM`4bG}WcZI`|+_@P}o5W)Syuy=2d?*->ExvDP}=l&miQ;^KKE zTcbH>^QY~UaL1qMhfR-=Rj_mOeE4d@rpX2TzazA-M&W2I4cW9qy(BtPPXZ`ZfzSuZ zk>@?NqyH^;koN<2d#EzGfl|wRy4(mtGDhAcT;J%NN__ zQFwm@zZp1}u*44HgEPF71KXw&!5ImajiXgduhPD(IL!w&@C=4_%}gf zkM5U!7}_H)iO!q;-L7R)xl(=TI(nATMf>x&HXAhQ%yqZED@qZr&^Wz;6veRPs^Gf4 z#>Oc4DlF_V*g>MR!81T1a0nNT#`P&Bfc6sW34-uebL#rD=F7$^QMjB<{%}sxJ?aU-9zxUDRd4K(WBH zlp+pQ@AZyt=3Gkf*xlZ1`C*|MMyRM)QgkXbE`5)zo)t{|HN%TbM!yiB%DF&>UW4T$mVOcY1#kUoNK1OTm8;3T^$Ouvm^ZoTWk#a*UL?O<*` zK^Qwu8n z0bE2I{{1rxRv?-Bh6gaeXxojajE(ubBO*@wryh3ONwBqt7$Q@&0hspeZ$f`OKp;|YjNNo2Z~d69o|jUwy>NN-3M%W6f<^l3#a6g&ap z4^z+bvWBt5CEEDs<@j5S)EvPHc&<)5!k-0DfWUKixsR-0L3J}T`tlDY1q)MNf>CQg zJ_5632#(|}YqN}#GC#_4uXk?<-M>^%8opAw@x6Up{}m&{8+_b8{Vo@feVHfZIeBwo zr^v`RQ&5MmQNX%fw9mUt6FBjZv<)zYW@>d>2Tg zGh+j(;8>n03wnT+jnM5T!G`W$ui!qWa-y_zJ_%qJfxJwQ3?HX{9p1}e4usAy!U+m2 zd?Ls$aT~wVMdnNfqg7R*N&1?#zlPW=?cuiy65Bn?CM_f=WWg+Wj4tZ(&QaZKVp^3{EQxoaN&`wa?+A_Kp^Cly7V+46^YF5NSM2|lCN14w=2zDT#kc2 zwNg03=QH+qaPdY{`_2+$`o(pU`gKm-;`OWFm!Rzf>!OH`zSei?tDY*GF&INzZF1W?GhAI-=~Ox$u$uS1O0LWyjO&{f7zw-L+B+Y5IV-w2D}+8UO-ssqHMW0{^kaT{cn+h=n#%ak+&q40qJ6;lUo{E{xG55j=APKxWkEO zMcUBCHcvEQMMYE!(yVq4qDnSjJ_npHcKzUso7^Y@s9y-n;uKP?vyT~s_fgUliS-a- z6NT=-K%>5)H!Nr^yRJSsqw(v{=bXi4;H9`mW61&Hd?loig;9Q&@$aIyCcz|}%|C6r zZ9SI!rq$!s$?GU!fMr9mb0;R};7{KIdRt`Ic_{LIbF2EkFo=4#6r~nm5f}T$wR?N? z-jewqR5T_K)si<_h-c+9aNKF~&9VhTM~N(O#Iv({*p>$C@!|m?G!^c_FtOEWhy9sH zs!KrjuaWLoIQz$v=(PsP;tGOb(nJMV^1rU1{RMf@I4+QP7}oZQk#+QCxDQLh7joUX zUfb4xoq*!ygRK zaAmh#VI!GT%i+!^Ga&|OS|tCd0rfD^I1J>ZvbJo~7-A>3lD4WJc25;=?Wc+JDIx)h z;-(;MlB;kcys!##=MEO3=3&IT6}__>X}QNGbOl8_FP1fB%XU&$JeR|#`yScf9d#@F za`!VGW5@i`cxM%}N60+778bq~HSUXSOkqj%*ADrH{S`? z`t^-<;KsN}t0d+Blcbi>hVJmd-G>wsefJnw@UuWae9R=VGtuP*eyD}hui0Q0*#yGA zjR0Az=C460%0u>{Q+=MASig_i${ar;OF4xCEMt9zoZdSJ&03IbI!)|utg+?Q5)D;% zp~fgA&os{0fG7jzPCd(g2$%2MCSEza!r=A^^64P1s_0ND3tZbV7uRVv#a@nM>c$yx z17Y^u4*fYbRJ3DyI^K3PuJFtG-+U~=8c>^Gokk+C@2^AFIRDQ67o^mlWq{oc*Z|vj z_#O(a%D`3MKA@SZEp|T!hUbzp5hZHIo6zsaeCe5xD9)lMXd`G~jeqIL!G0}RH)XHV zNS?~j*e9B<-yg|cyy%W71xiNS%xbFmF-SQZ8e}>@)pawyrP)P^QIB1ByhPZ-<<34R z1DYnl_Yt67xK?m=URb9jfpj|TWtCbIA*n=&ADCbrDHzZ6S4Fn7VLPDTI5 zA&bFdBd9TymNQJ5b%gb|jGw(jBdA09WRt!lX9TuwB|9HCxBUHn&0Y1C9%iw|LoqRe zJ*w+lbNfBI{hrqtMG`cYa32BCnV$#$6m&u>NZHV`%TSOVl`{r9rf8rXUT}{jd+6f` z@=pg?Qfd$u50EAJRHgeAn4F#|Kp?3%(M2U5v0UNW%1|;apCpivYIGoA#TC*p z)=Euu6n~vf@8@Gc;M3=C>c)~$%J68#HS~fK3IgH_##EW3Qdq%t6yen>_4s_3*n#J7 zVSGfDn?IqmHU3+sh5uczAP8}Sce{Kz&ybYqg!sUxZuCk3tv5hGkUS_~FH%;{LVU%` zvnrIN?XO;S;iN3&YXiTeG1l)MB8ANr@P{FCWwM~4bT!kARw$DPs%i+5FJ|K*f)XCm z;v!=`&4a#Pe2=1+3g_rmXml)Zl>)Y_q@B5F_qMta>7>I*)6ve#dtY>iAeTGwVTr9N z5sS>B1jT;uq?!ZP_m2c^8;o~!0uhLi%|zpgpCfmbQo;h4zG?WM8cMAAGX!IpLe@T< z^x^|-`*YH;#d;;gAOgB<$z^;P$Be#0!K5AM?Bqg3pCiPUe$IYaT$-e7uZz)-^3BHG z~;vJGjZq4#P()PH`@ULHlR<`g?6 z!d_tf<1oFKt$li_A2!pcT>s$0w7E>ziw{$=B7!Ixg?2u0Lj0NQ`5kV!ADhH{oINYI zELz8(JsyJ@S}V()!w5_kZXzATF60j$`3uQY|I#(mwD?|i|7=V!AxFKUTq3m`d!HhkOM7E)@JubWn9oRX__ zBR#(~c6)QXAwpikX=Q86E4k#nB+W78R44q7QRR^y?){bZ`O@x(3spd}k%D>O>*@|I(4vejoib~X+7egT;|#QP3;@#_ zzrb01eBFX=goWCFc2+Ep+sQ&?!{r4IutVx^Uea4!me@p(@!>~A89tbqv8`DP@{kBQ z3@5WH<8Y`)ug$MTwL_4OBq^2p!=bC+JkmcY7Y8R-s4LhU=eSncVX^8|7l^jV`aacf z6V#dw=!I$w`tL2)fj>|MU!2Gk9Ja#bbsLSFi8I7xc;^Nukv%dsxoIF4OWSV=`5S9{-|S%l z_{<&yggVjyf8b75am(FnS8`4?hM1drohN}`JJHGmsW8W&eIGgmy|;`+>5*e;l;3?S zO`4ipa`~*QaL;sODXWywKJHJam*vESi5htWS1wagt(hiT+mM9KkPvXL;gZyl^ zJ&Ai3urunj5vP}QpYS{>O7x?MCMqr(dxu2>#)Sw>9rgOvF4&=r;`ngzV3zQ$!r{8$ z+er{?pX-}8Nn`+pp(s3r)8>XIA;~>Ufo_=iS%>;O+PlWo}ysT zqau1J4kyr!bY0KuWFa0Qmx-qx^s#RN25-;dFn;<z<-y^{xNsEp|mP3~n+FmM?{lt&}-?l>RBw0D*P236IE|2LD7-Mi*F zzy<~asZMiRh%Ua~;&M02%`6hEWeKT@J9K)u>m#ntNB=Ce5q+@@+S=(mxD>aGWEsAG+v)mwb1=XBf=VR z@ErG5Xvnx3-un`FyVZ>IxP@gQ?468xOG4BEeE`zPB~CK$TZsodB?!zhm`aspd)I$) zy^u9z_1mTt9l4=%B687V&he*^Bj4Sx!j)aMjJ6)9?o|;WJ`Y!*4N)tS%}21U62pZ! z`NAgj@2U<@Yt(Qv|Dw7bsy;A-L>j`JAU(dKJXv$HPw2B-6P%>Cp?c$3(vzJIM0i>Qy@4E$!Ky$1L9kMz)@Z@tfkBp# zl?vVm-KKxCrG09l5lIqsX#!>2inJcI*i(es1m5~heT37Cv@>O3?!F4-qXgqa-eZYvt`o>pcrRsdCfAfs!U0$$rm}YA3z6-K$HAn-;sE;bBa})7lh)+)|Io}> zd)H9)zWCv^qAx5cJ8mIw*ZHn8GH{5Svxe;Y+_V9INAzp;(vV>j;{ECVZ{{oT%vTcB zUD!6A3=->E+GRf@inUuF8WI5MODzd&mz9hiLeQ4R+aE032gkjq^MR5EO(IO&etioJ z;QaAOmfyZP*v9B2SxL*h#-7OBxqfH=q`BfpB%P`yBO{v}j6R{_z04?6A6>h-plxIl zJ14A6P#3e&JC!23WkCxB2da*Vi;@C)zCW-j$wm&o0+b28H}NOe)L!EoT z)i`;29kVtyH^3?_c}!;+o9`3;%OLntk7!GskUfQ3wNI}iNsw4;zuZRk(yH3o=_wM1 zYl8N!D__kAZaSt~r*ySaz|IoPG!?nf)sUEPTO3>{CA)5Bg9gR@z#ZKDAh5NRhvrmc zD&=T4`BNoB-`@?jsXPb;fZ-IH%{<9hqjAjBh7G zCv8~rSKNORXH(#0Ky14<8cvcEXpq5IsB|WmPkLdXC5d3fA$$8roGL1mk==1UhS^=$ z9k(T}#mINbYsktx-eMQtnNViVF80MBg*b);nY zk6Ca9FJ^Kt5M+1uKrY*J>bTg8eO)sS>*3Eiy|{^$xQYq+k@e)y7fo+I0@#50gs^?d zJbns+iYo*{x$N8m8JE%Y`;@X|>?uHmMVNu%01@2?irp&Dw|UpAlI4Rj`~G!oa}isY zQai?5MZTkQIo?Vq=Py5`ZDE>Y!7ThvrmoRFRSJUwn(Y5xSgP{VLvFo_+ z7Hmn)+DeK_qv_OkmD50MB?@8+Y@4@xC9X?rh-%3UXFn_|Kq9UvNEdH1@W~CFl?#c4 zgMz=l?m7e2NU2teh%r5G6%>WHc859Z>+`ONeYX>N$xO|w4xZ|GV-LGw_0aWp75ffG z4@n+nz80tWg%v1!&dT^_GvQq?m?pKx4%uT!mG^;n;H#`zkauyVMDuDAy$Qi=@pXQ; zgn7bP3Au}tRgh9x5-r9tsUABn5rezBK81irLi5E|f~xx`i;#LC5Rk70v?4!tS&$K9 zKgwYsnzZ}6(u&`5+aOSvwd591;n(uLF50xH@`uXHKTs!_60gi!1g2JI#(5OD?a32X zSm{9NuTbVGHJTmy9<7*l*B$nCvgCO+v$!^%+czaiS`vBCUh(DVfGou}E;bbV#>UHK zLmrQVl&?*$xE_R2gheh}P)%WC*t&U|WYLJ(w3dpCU#=ZK`U4925M;E;A~nr*X`{It z^|X{YvJ#b4cMZ@YhE1K3Tpi(<&^Duc1#pG*Y3eKQrz(kJ!t0uw4IN0>U ztowwOjRKmuwWxb&XY+zLm~*hjkjpUWnD=U2j@}|=b6@z(=3w<{nnl-jk@5Xs4%=P$ zCg+P(no`gWWadsM`7@LT#1X6O<@I&;T;BtMrJV@tOy4VZZP-<~w^w<0v z*O&N#w@E(UYEk@@vJeCxOgtkb!H^&y89qWwS91T}0g#e;8g9P$pd4m!+&InO+-}I% z{GeHgJU=LsFi~Sl-pr40dy$^O0nA}0@y}Hk*+L{MHmWNzHk3q@;T)XcKAHaiX<(lM zA0a0uoP0g}_UTb>Z64mWd}+iU+fIA!JV2}qV)-sg8=`yCG;`j*pQv_JteuEF0WJar zvBQGQ9v{8Se0E9Ts_!xOP1r@Quz;^OO#Wa=eXnaGfo$G;yEWy#MIiSBwH_bEeE`~? ztKjdWl(*&R(4KdyN%%3qzpq|Q^NbCm%fhxvQSL$?{-^^N!;^D)xVGMgY4X&!qvi1a zX)9fs*2iJm_L7>+9~~={rr7f# zy?D&ar?^*f^Qc*%p|I*4k!EvuSgK#jl8?>dBxezezv6n)owO|gerUAbbY478bx~Va zM9@$qTj;3bBO*bOH&?&bEcX4R$ej8kA@n%LJ`mI%tvn6qlx+fug7a#h6R*#?1q6)B!oaOt} zzWN0YwDg(}?W!C*W{4wH@dfYx;niL(e|nk_M}N6lB~xz~q=3ie)_>R=0F5f2eJUn z+ADUY8ab+arogKL&ibnl8Wp!Y`G!PA+6QnG;YofowyxAH?;lSowflz^oeqM)ia)Ow zENG54&aTEE5i1Wsd$WzcU)90mbPF&ao`;EVIti^~_k%mof1V%G6K>LKGloYx$Fh?l zmCNB{PeV59jD3ZN=JcPf zua97=(e%KUc-JkyY+K2Ly&CdLx>Aw6S~QuP5@`fivYI$T&s8X|TtuPYYDwe=MWQ8{3l*#V*>o3DWiFLnzq(yzdFRdi5B8 zDlqRfs&MhkHdtca$1uxCwGx+{Qzi)h8qPdl}ynh3rNS2jw3QH^Bc7s5T|k>ze>y z-XOt9vW^B^PZ{x{^6G*5sim>YS3SQ-G*W{;zp4dtg2Fa{lD`2} z1)B;sx1d*unqurr85N3(qKEC4nrE2liQBBR! zp|wp@;U_)p)5;>otpHtqv*{UfBRiE?JZD0VqY*FlWs9gD{%U4P_Qw=KeeQ5tmA4F? z>Y-hM0ZKn0*vlp`JC03*I*{=`e!Z_D6wUqE-Yr}Y`($g1-b=(KuzmBo`gn3d-b+@3 z+k4^P*izBYgeR_9F`Pm)c*DenJ@dVp;tjzdSGl=1*MJhTTcC|b7B6kt zQ#jaqnXhCh8Y74=GoBea<}xKpebY>JbC^*_Q4@`R!0PHEFlzQdt?3WB|8p3J+jeRXHR+mD1ikOZLDu z1Zq`O{X7l##clx;qQc(lJehYvNX8|YDk*!VyWvzVd9RRGsi;!}byg@X-%`|8R`BZc zrUj(9V#h?6beX(Q>iT(K3j;s!w}$afolj4N z!698z2H)6ZaAB1bZy2va$dbC? z)Z~(~HpOac)+s|g)pSZENXEeo0uDnYmjH!b{SS7nTSG{567BdaN+0I4M=!0Y=))2N#(BWJ2*0HnDYb;jCEH7%liK%V}`Is;d zA82FQ(pnN{MP2CxnlWGs;{$PoQhM&u6W;x7|% z=NK>*U9ZfjTB9*hPEC}EZ+X)M|##As<^}~uot}oNij_P)%J^x`nfB^x$8;;U9U`ew2)HEe>07QUQr!BM#}{5 zAk9tOXgmtbnga#r>nL?Ma2nU;B`2m@l!3JreoX=43o6gKMyPXhU%zt;2_t-E-;L($tjScBpSEHHt3(Cg@m;Ln|l_$=0sw?nLe*H2RDZVE}8`c$qAu|LE&n;aZGqt zHP6f?#bo&glKuLZ(9eY!SRx%8s+=(F))Wmfwb$gT9-$U15CSY8WK)Cno)9wHSUdNI z2E;sZ$B%^^7)bRYO6w$#aZ|wgP_`y)*3_fk2^zhQWm6W?ieK$0`V0Ru;bS#Iz}+gD zbvL>isiitC>&ntPfmKK)+C)#E>qnOhLajzqFcwU0 zd=i0Mpo*GIAddx!Gg*Bwj{PO=JTG52Wl!l7D%%>@I9xwcsA9}0kK|ZqZdm+69THXH@PXp2I$2f z4}X?AQYUB=mJ@|L`F!`vD%w@0Q=G@&fR2FAKsNGyR#SA9rqCtuGN!x0VWm%wTm$cM zB7w4o4=G3QKIMTpbUyze=mBN{0)nJ*wAHgu`~EAcV}VbeIuNLsATcu=&^Lto_q252 z#B!$o+i@%Fu&4)pFub6UHON3VY+z_hpi=YV&#tl-MDWt^oFDjyo^Z8p{R1xPJyjO@ ze#n}iXk|r%J5??2Avl;@|IEF25j=fjhci-ztOOC$>qE@})unnYaob8>3=7sJQ23k# z;h(G$iIl6ICei_#rDCk*=?)&UBTIPp(9Ksg&_M?@oowL(?kCIeMWni2t3;!aN7F-W zsBgaQP)UrLj55sK`a)h0o$8tSFj`9kT6{@j`3zkiIYD?4hvF$4*#{Ng3dr*bu;6r! zsvsschw#$%m{ZvCFj4U`5X09BXc&K&;z$aP3VcS#d+9|nsaNOQmqXb}1N>;!l8dw} zX?Cby`2M6SWAw~(Z0_UQnb=O=w7aVGugu2L=vF%%t3Dr`nv$9JzFM|tM2N-x6g18b z6?tg2-(%ZAvcnMrGGEJFw4)~tUqZGT*qZL4kH?lvVfa-!2zNI_KF=rw!i5C!O=L3eDIe)cf_w$V|&J!2vZ z&tg2Y@Ii5Vf9kV+hyQr|xA3rrOU4%o7iJfP^Vp)yXkP9xklliCjY~>B{IB+R=H=ZT{~@!a&V9R#FtrSn z*fNjIy|>D859y>LFWq@nnsQ4KlLGW7IWuJdm-J55y01dPGp+PaT?>xjXtof}XbT)3fZv|MstJj&N0+IMaol@f)1MH^?^V#N-l&zY-*ynV@=q6pob zt+_h=`5_WrH^matZUF?bCRmMkcEm|~lny1gdR`(eEg24Es|F-0igz(;`G4TR_BEt( z2aXFyk`YMc1=Wo!V$CCLmSPcCEH-$b_sXr3U1qQ7iBOe$ zXePYAaj{bk+wCT;NF;LIqexFj>KH1y(p81y+&Cv%*k5WN0}JG}k|PJS|8!@tyA+=J zcGSp)Xg+gv+=w1`wn0{`EdbXJh(j&I@kQ@RA@I1`!VY@>e`f+3lPjpFs+#N*4f^x= z=BM?j9LvHC$A&L9Vvl=n%JrNpgjOS!x@^i2qGZaR1k=yl6mS9aOwf(rI&T07R#tSW zIUQ6ydjXumt)Yl;Y_(KBM4M`phDG#{+RMh6Zf|oP5KyRfH}4 z0$TQN!5~$SW~sGYz2bznpdHim_&dz4zUJ`s)||!eC3N-wpj;*@^T$BDd66T4#)UCO z$;t2B4zOYKueXvT?inedWdd<2UX9$nP@AcO`lc=CDeVH>6QAK*!jZjEJ^#}tjIwS2 zoz&ShpOi=b_Ru*KEs5Z$+{iz86np$Jo8de3hnY&A>1TaRuPdBaaivn2*LL0E?e|5S z6B9+G&(RF>riN(wxk)*MYaxM}6h%Tumhw!c2Ee<_wkiwJ=Z^5=y4I>L)tCiSn_IbB zBs>zow>S+jEA{oqZ*5A5aa!5$f_1nr#wUHxb4thhVwLGKhl3L+rDQsincc2AWvoCP zledRKc3}Q2NTn;Q1@U9iam3TTKnKn{DNy z21Kr;qh3~`FXb(fe-WN#@ERIf|K+Gr%Hz3hmr#O_YXJ@>=_U@gl-63dbRiJM4r^Bk zo32A9Vho_N#c>=qZ4%qyqKE@dsO&DPP9vrdM#ACAA$BsLK(EVNXlVMU2X}dtT%y;J zvxCUBk=n_xo=z$4!v^G&$!US+>z~8cc6x5H_IrPX(S13LyNODz8dHwL{LEO&yb7#f z`f|O2S_qT&317)T$D$(q25QBpW;EHWFvq|YO&LPmCgOh96YPz)o8v~0{t@`;-zM;q zpy~x`07hScK$5E5e%Eh%(hQa;baajGLpnkv^QWpxzd?k-qfvL7=s3V@@Aldf+}ti) z1S0P-`;!o>NkyztJ#{e>;!?W+Z(6aca{t>MVMqU^EmhdD2C8P1Yr#Z+^{~`7nwu$X zE3ktw#mIdpc@AjWA3HDNrqs)J?#}e+RImb5D^LGh>&0XrH(VU5sspo9P!}9W!r>aVXgcd8v zZ^$dp0$VKARsP!NZM}@_b0!c9XTR_t??6jaa)&#ziFoRIu)-uek zQ_vCh#c>KM%x}n*KqLVYCEx?PsN_BP73@%7jxA}cg+HwQk{6dzb8$sHOdsp@KaI?| zF;YodbxIXl-qNQiEseNUjfb*PwLi{Rc96?v^E7qkCCoLqZ(bQP-W1!B!`|E*uqY!F z;1lwudGP9gf(Wx=pOkI?bDmnHvF|?)w`&zpgHAy!1}bW}EdVtMo&F?j|IrBQ&ihJd zT0;j;ckE}TqL-|Vp*b0lH)QkALtpUcH9)M-C_ZmqH917MV&7SOb<~IM#|BU#^7jP- zWJN|cGPL>Oy1!*FynF@5@EOY|RJ}O0$@Ooq*NXnJ5sL6CccZ(}+yb4~_l0Cc?a_aL zOB_*EW{7now_lYl& zXOH92n>?Iw38|y+Ht>P?b6A2ybi2VcpzG%b317`2xeu*^6)Wemt`3QL^;4HPKRCA_ z;*E-ZB*c037J2FNpP?(b6nA4X`~rceGWKTFqv}0$B6-rj21CVuoJBDZa%(4}7}lX*@V9-&a=?Q_IfJS``YdWJ!zbW}qU?M+jr+|8$;Wd!ZpJ2NU{ zq%;h+DlDgI_Y2F)xQT;BB!MX~iJxf-`@0z;#f4zf?nX(4Now^nAetnv(ZYpbCn{!z zK4-EspThZ*Bpg9~2Sw2)-%+$eUfy(Bi{VW8r+I<$IU83=pS|0YJ1xk$^D7Kc{G`7#hYpXbyZ4&w`>o2@4KQFgB#Yq*i?Wt z1Xeqo`D8J5XgH*8Tz0)N+?%9&OW;q=15sAND-@^eBfOYN1PmswQ2Qy8ImT`%wXkrr zf;Vo)yQCGQbs0~~xVT_2sUNT{2xVGcH(IJHyUM8J-lgu8MLM%)8~h9aoD=qk^SXk(KtrVjqW)$m7VWYA{7g%oHY3Dp1dP zE#Kh1IH-FbVhz3SPx)PUKOz?ehSQvw=m4K+{4-Co{5|V}5tpoHFtBK7QFwpUcvaJj zuqTbQ%e9?`S07|v@A-`ipJcC^3AYf&17C+jR82^%+Dz6J1h(c5y}dXVGP!(3e+A7T zq@HL}9+9(#7yuzbPfZ@fsGAyfk}-yaaI!znPox6$;|*@kx%5zcdjF5curRL!;02GRq;e;T^k#6!sUCUeS`C$w__H?729bwqA8=!)1_$u%z=n$z+e*EX0 zj`CAE5e^NKDj6Gd4I!S1i0&0`jUSR}e6H*S`OXmM=-=6Y#cH|~KdmhnQ4h$g9IBVe zIMd|oH{p=7^mL?*{=gskSH8oJIJq^?)NxL<173png2^K$fz@FrR?_8jga!s`s~f!YbykpWCht}dzFcK zbVsqxD1cqwXaG$Rfvs)R|I0rX5xNK^P)p;EY;#r=SvMO#j5fpdx^rfKYmY^kFd5sd z(sg1Hl#%V?EQs;!N}yMZPOx~&Hje&0D|Vbzl9BmF9wF_+>h6x=7oS+4SHFC_olfel z4qApb@!jrL_&p`grnLARd$%phUSxFa+txj^cvR#|C?4VVw|RGlwjxc8lgqT3>HpWq z)yFAUySE8J(2w#W?Ylx&0cK7E$y{{(%FiqG|7kn@ic2(hy*b73o4BdMJuGbK;~cwE z9A;hW4Q5)uF>osU}=y7qG@zgFZi)!Ff04=dY;W*U>@Nm%J=UjvT z@|d$Px^I~ZW%!Z$s_j*Jfq(xs=f9&Or?Z4d>7pvc14h@DQnH`)!QdMf&+KdSPnRHx zr1kOC++oTV@*_XX0a%)}EF|cUpIH;=PtjXrg_&P10R)19J^0Q5pjn)8Gf3x;RcbjA z{cW|0%V{QuuN^RQM2zEznBHJjyUbC?Ie$d91m(EQP9c!&(7uQw#uW*jKhQ|s5-1!b z7I8Cyv;~XM!gfHS#t{wr4`OoPMyecGm>^RieBk-@G|O{?4&vfcd$RC$(sTLZf2*Fl zTJH4~RJ)MJ1~QI#0E^uJQ}h-bNOm7axi|qND_^EjU;9_;rJSrkkxzF45pb14D3Qh&GKiWfegid+%-x~vBD%3JD|XyN_~F*Z)JkNR>0!bI2eX?;Y4 zY12R1Ba2L_E6fyDn?&C->6y4!I>iDP`8Ht_%x*@{bqf}W-|&s!EP0kC|2ik5g)Qdf ztu)ZV&^e&!(WEWkCASPQ;T*yb8j-bf)lLuu@nA}O{RL}7^18?+;*N9))SZZr3u2{! zB#e@|w;f3Oa$R9IRW*%31)4V;dbt5}*}pUJs^`vL8OeRi)m5M>6Pl-OQ~j_#e#%j~ z$x8aNrFsdNPy+tMGLnpLU>4Ui4rF;F9AZU@j9SrU(^pP_CXY7PNuHOU6r`DdZnH{= zN8)#3m#*!aaIUBAj($RaR_iko1J-{kc;|;TYvg6#?c=-~HDYm7Z^*JfxkVbNZ{430 zHvCdi(7a>+QSO+8bwEv~ZjagnBvq}Kb(Q=TU_;{Apzuzr!(=Ka)oIh_d(U0*Xza+` ziTzw%+^y6U8HQuNS=&IB4J*@&GqwMmbvfM>=w94-cuV&@cZ@t2(59d0=fCH~^&lfr zqqN?l4lg2^e>xQ;M4t=O`3Kni3VO1OE)4w>Ib|UD;^@oO6+TZomGFs6;W8|OR=VI) zWKX&1pyV4o64L~TA_q2ZZ7gUQ|KJOyu2v&e3DURt+lm2ucA<%1pGg37*$D5S zEt60Rek(dJMB)!F!gfZAZX6MmaRuQ;dq(mARBh`N%3PGg_loK6O`axE)k%Rya7?Ge*I1_9Jz9!SZx$&%+`WX;|x5j zTQ)^ikC;xKVQ;G|KEBvFuWP><7Vt)dt|exc+Ci87Fsuq@8uHMWr{WUr^}2mI@WB@~ z>@sAON^`}j`iS_~`fC(KfVlm}Eb}wZMUn5_X=WL9^3^~EzoGcM1tmWTQaul*XxY!G z=-QePK#c&JAs3Y6h6}G*DmJ)P1OkQ3CNtto$tU8`c9u@%?sMpCK~H$PAyVmfY%{Zl zgKO$=jDxa3VKaG}A=>#L(W(6q=7qheIYRS4swCCF{+10S51X3k2*wnsYXWbDrA|&K z=#m>NM#^9#ikHC(QN^IATd69&+7f4E^o6|w2*Q>I-7LpxvSH@HA&6m4(OepwIIdya zcz7wGA#3?6EP}+#)VOL&C$Vbk<#*A4$k?kUh-z$>&KjHb_WwWaF&F$lk2zHM+2vXM z8@h{O%_PcjNcbtt=7fbu^vAP)Z={FwkSA(A1!!A+UI2o=*0>v%_UD-2wWUo##O=iw zg@4isaVR5tFM-cMb#vt>iaKEI)XTIR3&GW-lzCDK8pxnG|A#Hm!`#24Yisw(D60=8 z^knMwU3!MKlMjtF8vJB&A37uK?GY-CH(mt{-^auU~!$UG6 zDtoS4vo_L?V*)cdMtdW-*X6UH{7YRjS?BTQF;y{KSgxrTye@jq;vmZsJ6`=HP|c!4 zumpWKCTWJc+nATV7EsT(=6Z?3Sat->9%Tvss;G#Oj% zd<#__(=N961b0r1l@=YbGoj0bvr`li8lc<2`qMPD&W=BiL9;l$TI-}LhbTGH(l^vD z%g=Z$Z-|km@N1{;2}$`{%`GW49VJ`wsH|5GNS_MPNFa$+L1&NG+u?n@8&wh z3YP5Ow4(ZeX^^1OeM1?s(0F&wfN@k|Sb2dtf##2PU7Y)uf5w)uz{ca`xY%jR>qK+X zjHuRte!%Ss!z8f4I?cOdH?BRoGEb(ms@kfb{^Ur-`KR5fS#V^S#krI1i&;detdp+w zt6$%KNnG5d2b_Vr_sNm*Jfqov4QF9=eUb8P51DKXqG?*UVsLsb0tFh)Z*h!@-|;l= z(i=`VLX~v9^UzemwQLH+ThS%565ljRhsn)X`Y*^Cu z!DE-v$+ipueN{X$FFlG%Vs{Il3KcUL_M{D=(aA^0)0Zn}6u(bT0Aj3~sV1Bi+7vIZ z*Qs|$B~cjD&3KOfZ|tP);@(l6-_VpF%U(Y7ys?aHLx;Bi>(uBSqYnlHIVN1>r@xsl{1>{few zjWiV@W!?%ZV`Ir=*lq9tDBU9b|I~YZaol{pgAH*koHA+K*cH($?Z>lAmav#C7YPSUjK-$()qx*uD1YLexu7+u?H86JwSQy52Ajqv@s!Ui4vdz| zDv|UJf}`cI__P8v`O@QxpEfUNgBM$R&skhjd+c==q#u~a+`;uHM$lNuxAq=pGmJ@* zW>(<8z*MG*3K^0MiIYY{u;rleqLI!`Td(cG1*nqvx9Ia?Sp2cyV8Tx(c2f_ejl{GU zt@UcfX`ba7^YZG1D*SlcRYLgY$HZ2p{to33U_ zz*%@kRm{+#%JqOQS?N{5(waRNnl^!+*P3sOgMH2y*FYrW!62JwHs~u>9wgM-mUki% z4gP2%NHMt;5duG3KkpbvZnD@#V<`?ioi(3y)n&x339d)c!Yv&GoZv6dsGvOx@P7=` z2epbxjd=oQ2^t(8H1*I&bZ=?6d{2U>O~jIpb$1%G&JT4;5GNrg=2w$g!CspXB6T(B zq64d>A1G?51wZ9c)iZ>btQVoJ8Sux~x2b95@I%6iO!N3;VI^|VrsgLQ; z6tZIenmEmf!_pZEl)9N#^0t6rMB?E8q^3Jp#r9Oxk;c+gu>LXwWvRo(J<^- zoBc`0T^_$`1R)W1kg?YgxXr5?K-qa_8`)g3*l20DR1#%1JVO}`7_l7+u+=#_bP#{9 zaPgT%DG8}SLtOCk^3bH>w`utYL5#ynQf`>inRclNOq)`Q_5)^*mA)#r6UK*jH{i`A z1sy!lf#1ZeSwb#(^4V0g8XMWY_=owsPEH|bBFA?jeW}UR+@F?RF9OPlkOArS)&|#( z728xEx}>R=XXza69g4R?8iVH}K!V@z`G+=WFO!7M&5p<9+=ZnU;lP!wbO#k0UEvhj zJnu0ip8o-Bhh+u6OVa1nAmDiET&e|jJ$qSMF1tW@kF81V?8slp?AEkO(J z_*lZb=i^E!x>Dj8n}Cltk?BzS{Mm-oRGL;-9&1FI*60Sn;&@yjUQ1UuVIc&BLvGZH zk-ahdhOH8@7{!aI|*iljh_f*!#LQ++8^PqCxt zbY325;qM%^s$ro_+1G|1SUC}8%aS`M%#$?=N=~8Wdq;l}z4U%QY~6JoB70(i8*GJU zDfd=qhTR;DT+1U`c7g4g=4q@yvTQoTWnAxv?MXM>=CUWJY~=UOBY>c5mn=iW{TL(K%wx$OX#J_H8G0M*dh9;FE0okvH&q5fG-MxTu; zV`+;36$Q+1V+j~@lXKvI$G{~>2~O0PVykGv->Pq)jx}yN^I=yaO&;kngo}f=(qgI< zt2ymbJzmurl&d?o&_gFGB9_#z2(SOAwHfAMCI47#Gf|9^@Lx%5p5~{aj(Vh=-Pg(p z<_Yf+aXnL)>+QN?5QDKbfYjT!Z_IJ~!`!u1u*C%R4;kY510gc8O>RE69?N@+qkaNM zcqF;u?i20!2Hr$SSNZl*sui`@J>(V9pQH$c0L~S~R%H1dNaPYSGv>i^4Y9#hR;orS zd*;c%0{c@pp`!GWnoGi(Ltq|HF2v;1o&tHx@7Lwka9`7TQndq$?8&D!o@B!``-U4&Y?jd)l*?vQMxg8vG2>3 zn6C@V*C?{eI>zZtLvxu|1BIlJxBWiNm$c@Kku52<|2bFv(K4lwD3Z@DCO1{;OmeHl z4bs&xnitWEUGw^s%7Wzx8q;B`0Y-mdKQCu7I1Uz zO>6w>?RNy04*POUQ9Tlc9>dOOk1ku@FX)K;L{*B$A69_A> zZx+jyUMM5GuwCG56~Tq|4$E)(t4=&g2}$EF-`d_JqT2u(y(J|4_+d?>71}#yNy8nO zhaBtWpxw3Zrg#7~c3q#V>>S9tC4(#?I_j{1 z!%WT;;Bc?BYmDh%ZG>|-K50+L-o@C>dbjqf#d#}bH@Rs?Z{rUB+5`U~9xZi6+B2=7 z@iZ)wizKT>Ty`Q}Jk`;r@bWwrbV;NW4m0MFecGMr{F=fF&zv3Q3>iA6g7P+A?D`Fa zFcbx=hOhsJB0Grdd<6zVmxoKr5-}nTIpQDoZBm>9wvO^YhJg&0&8HQpN|i!Rrdlg9 zqMB)A%X*okS<9lr*(sp0JQV^VdQ_6PWJwi`jk#Te#MB=mlwpeCLBdC>5|*`*s?_7uWEs6cxEJ1jRo1B&;~b_Ati5?`cMU}hK?veo$y zC!|XWnOLv|hwEP?*9tVjhbqtnOm!qbbd^6*)zJ(bK$ggdX+0TwVD#L6b)9k z;Bl7;LQEg*IryYO>>*VEuAd~ks62%Xomr2B-{LvHjlhaqltA0h21b|}hyx~tGlYi> zBVJJAV$OX^@oxqx-G!jOuM&0MkKNc46J+F8SieE1s}(ea@a9ojYkpUHP&};N;8A0u z^Jx=M_yYT$!0&*7(A7ZE+<;pKH}X)^YV?6ueLOB?u|^9dY?zxJ13iC2FNh+?g;K6A zqb>ytmzvom&{(|4U0;(xu-zg?(*7r&66J<-9$T<7DC{7STC6A`B02eIW z`Fe$8r8sR(c8QcYoZ%pvcRot74cB4b;STm{+d~IuWcHw0lT@n3wk;y+^?2K&i zRFUf8EAo1gB%H?KNEE-leBFDlAE-1mjOAn}=PJOq0Bz6ge`jR}P52y7-Ei-rF2 zvpVG|U{Xkwf>(i>TmXjEsTcgBlp%o&1mlA3E0%-Y zGj=9)2;8zw*r~V1JgE>FOl?LxJhiozBKmUn8#|Y+Khhd1W$$*nM>=4FhV$OkS$%Py zYgXf*Q%89i)+cHCgYKoA?&qicGs{I+^u=<4&6EFRXrHN1J$PkFUES3Bo`O)x9vH%%myH?X+qV2$Vm8nc4g!|M1phU-q zWUUE&pDqrAN!7LutIVtg70km^rsbb-;%ShBmOp%tZbco{1jw&o!(f;QakrfGq8k81 zK)kV)sFYPutsQgSvm?jdS|(Ii$jwQTG3svp;8@`lT^9+;lZplKXPQ&~|xot?Z9Q zNlTmhB=qsNjm~W`JjiggBO88?H(?wT0ZGv+FSG84A^ZC z*a;z!zBOtzmNOZI$O7}P7b=#(jz=BB+)8%4)kO*99?(Le7bpK#3Ic?oN4Ne|sq(29 zX%ZD^AP8kzlU1V-{yOPrSKeCwrgC}#j5wIwT%Q= z2zz)Pr(V}zy<&-#wf_oXo}zSW3oOoHg{aPZOYeCICUj_3i7-*Tc9tr!>Z(ZNcU}%{ zb?nwSzGSZ1uPL`fUX3cVwQCz8k;`^cKo=&ARjJrt!fd_L`7O=L*h#EoQSjA)ItSh>WbJrG0nJJ(~8+nVHV_xKRp3H+du-`l&#Vw5-0T8DX4=fTGY|o;K1~fof9q9-O!;{g>%Td!cdI~U4fSS&Ont-MV>!B zY-DB*wN(l+atwGi^hB+u1*=y@nXLFzKh7EP<6CgRk@;LO3-hGGzq^hoPEA&;Zo(N^ zM>AJafs=(%5=2_QFIey)ehI5^(M~8bHvTLNm)79C@RPT!03?tyN`fDRT{VQ|I$L-~ z4lC>bfhq|*_BKjdMD#$^CtwDw3=DR zGb+~8ut0VQPO(#zTI9&`k&6v(;TZz#*}0i*dUhqlg6x>ZaWKm}5=dt}0R*WrkgGd6 zKR%z3?Vo_BUI3V{W+d6sT#hlo!$xk;<7{2HBVUM)jD)+`@qwzXi0G2l=ejysGK<-h zWIXtbP}Qt#R;8=rga^uNb1;50&;J9;g@{5#1fL-^)@+x~)<#luIUiicOe{hw4Cn5V zj?$X#Pgg~heLmcbOH*>}n3WSBUf2|jDT(G=?TFp_BYzFB!QpB)?qcjb0uxC}+ZVdZ z+TFM)s@UT=<-W6tvRAwo&QLa-m1T|ik%|}2kt^zt+S)6A%?}h}2thHkY?vJGyIycm z$nX(%W*cCyA0k%CC^yord>wkU{wqcngR=NJIg$X2O%psKt(ox%CQ@@M-*|m-%bQY~ z4LnrD%yVj*D?772#7un!(-1{u25uYY;%U~lO7T*^b_|Dp--@6tZOtpZtOzZv$nCia zy}gW?**+2m{Q@mKeZpoK5DDY#ObA@ym~4)C+=r`5`=j?U_V!P+(ht)G7Q2zMQxJhh zjir*`lYDZNeH}HL)wtKX(&IyNHNrg7Y^@%UoE(?H@!7l zCwTeX1cCI4^x|_qGa-VgoA7Z#6VC*`QTMo2q8I60Ipfmho4Wy<`ahezVJQm^x8!nL zFFuXGyrlR0-#u4`P!_(X2=Ek3kdAUTu-Ua>x{4tc9|Nf4B0iSS9R9#>XqO;gn*)v1 zZ>HADLNGbmNb3az2o>giPNM|&9 z6zV-`naUB6pnHkDtOs?~Z@79&r9b#Dk^)Qoh6BY)=fgxg>`hv^;8g}o#d@u&Um@^j zl3TPV*WQGo`;^wKcB|?rvOY6O%B947J4Rg>M@2X#b}g~$#dnzeCfW#P>!hdgp6k|eTka;TvY znbT~+yCNzfJfm6OFVBM^N%u#vCsz}}>~m%rdIxp^5UcG1g_g~x>E2m8+NHWp+qibS zwqwa!wx|Z$*TOU}L@y+UI$WqK>~awm*>FqIgp*u`U7B_np1(}26d@wl%>-3VaV9!WDrw)6EuLPO^`s^JILVgO%>`!AX39@GCmP0XM|-?sgNCeyUSh&hN=%+#1N~Wa zzAlg-omC0sue<%8@$JOeO^ze;<%S$8)9W^D7+>%L5+Z~E22jH5%qthwJ&=^rgD4j3 zjWPR~Zkb%T8z8G^vjVT9EdYPVVpDz?AitSL1jq4QE%=aS2V7=v<0$#ZX_BExr<3im zOmfKvbE@Eno6Dh>9*W&g|75`5AHcPl%6{iRasL>p!~2!&UluQN&mpX3BL`|UWqk;> zog1vsT%F9U(`+(3LUS`}CW8v&AOxI%y!9>e(dP^l18MJT8_^Ld_f+ZJw@GtqpbqVF zJ&?+e_MhB9iKUS+HJ<)RDFj4uq3Lt3+n zj?$WQbG0k6^sJ#`DnR8U6~6r}R=#1hseQD2sovgkkTRm}RPCpa)e2}Ycjg}D&{H~y zSCUd~=u0+Akc=8EF)m!Pg%H$-CUMKVIPMhBYU}Dy5%wk}0?oU85U4+O%U#4{ir=Lq z7}eOesLM8$f2B=I)BxH`P?(R=dLV!uZV<)hqlQ>lYCKsM9yGQUP9S{DspK` zAzsd&QE1&ocI@Zi27YW*G4Wj;HA5wCU-Ija*h%|Pzw0iDX)G=M@@9u>G z*L5iIS7^VK*i;c3nJg21{sv%2-? zg#3kFGP99e*Mvn*HUP$STW?2_{99MBl5dm4gcwiBo#xpvCwF|U_4Gg!lnp(rxa)GR zaViTGB@c12kY7~TV8zfp+kLH?ZJ47fUg&(MYepgSrf)|?5A17nWMgZhKTgA4k63*r zOnRo@FxMy`t7mG5N1&yi=AHI2_6Wn}q8|kKoVa5xh@0LLTqnMEn?`2C4RcN=(E6Pj zMkl-;D5|7C-1OuYG_RgpoZ-Z@tK03+p$-ejoySPp7?qJtpDRHVApvWyJ&xajg!!5& z1rXG&`J^W9Va44Q@>k2tM|8@D%nj5vL{f@9gir4#L){$~sAY@S^si5x;E5#SbnZg> zqImx#TxpTg9Ah}1FZpmJj-OuUJP}Nxhy3P6^7|ZJ+M4S_pIDC-Dz%hfqd`#}KE*oX zrU8vTjO?~u>l~`Gth2;M%NjapOUozm^0~xwICH4GT};iR*9QPRx8%6`9O`<0=Cjg@ z^i2wHD5d$pB5@Ww)^8PJ`Cl3NCt8s1g>Nj*H`lf5)h$iRVEAL;VD;W@ZD99LfRhDl zt(jzun%PE4yBC5XzAOluq|aDSr%M@(3e%xkT$KFs3q}TnzCFf)Xr8S>Euh6U%P>+4 z;$TUI?VS8xHV^}<)(F>|Hszij`|4J^naATp)jVL?~;&J5n@P&}-cvar|Ph3{62jhl!y zTFy!@{XS*(gj8coJkD)I)4U4n+fgb0TgM*og zzkcP09t@whi^_T^%S0RYu*6FnLh3W#Z=K<4JawP#;jr0>akyy#IYU^ie*g>{908Ig z#>Zs$#OFR{AK&OO;SkL*qxOc%ZB%F!q*T!IqV4T+(jr=86yclKh~1X&Gpn?A8AkFf zc(`yVp6e$QMy0#xzoo^o7K2(yg*n}YqQ9)8ZF}9Bs|jo+%ER)+kTxBUVW{OBDW5fts=(`(WSK9wrHJy;Ws0;;Ny>>RGA+-u<$OVJ zW?-T>WwCjf34KLJBDf<|+15&*1(@rLY=(6?yv4t#1*J07jEWBufur_>inO=iT4ouF zs=>z_MpNH0y}gKO+AVa9!yeJ2oLc(-^ch{))4nr?eN~Rba2STYG@XF-E_TiHQdcm4 zApSLaX%*@|P?vA$wP-45H(uaul!B`N_ozWWm-XR@+(c}UaNb#U+w(DFTu+?)C>VK~ zW;${cGTti5xy9=E@s7|yrdMjay=xS}g|0ilw6kY*Uk9Umb(#DqV2&%=zB5%(DVd!( zM2m}FV_JlC;24QTVGcMZgv`?#Ip{K8X4+>cH?reK5Bn$3s@Tz?k2>B0ye-_?+G%N) zdyg8a0Tk&YfJPHV#<({)T--kQj}>EQ#HA5F%AmSZlgFS^Po{dHuTokQpwkcsV>YT> zsAuN_E@{rYhWgN-sg*eE7F)#JNo~%aEN@P)4%4riQQ9*lKo#IR_avRHNLsUJQ--HU zN9?~~%_toMq|?Zy`vMdhxbrxt1wX}@vEcY!CP7EdszZLcuJG2y#xUL&ipPp3%Uw{u z5aEGa5mVCHvl!Y4HI#j_5#~Sg^Kz2ME6njv2Gvu*c!Kz#Ve;2_CUmh-w8EAwyBGc$ zY*v9mOl*A_JN>Lk}kU7X_Ro8Yc5^N-8Dyy{nGc!70X$E zb z!WeZPePnXY)c%@U)dlqywS^}2F*OZJtjueykgru$z%`_n%--hlU0E@aO`%{rcnW+d z8A513_dD?z#OGXB18}p%A=T!L0MSQ;oHY&{yT~>7jbS{_9o9J|TGJa(p%$XZ2`=EG{&T9O$qT}6 zy>5MbH`!bx+NmKo&l=+)V_omj16N=W z$#naPu=0Lv#q^Y)z^z{@^i0s)iXaoP1@XZ6<1*F|&4!&Bfa-EVflfE%DD;QOR zx?m~ec^H!Xc~V8Y8|M9?)hlf|C1-iLXy6b~2|HdNh!{)ClEzU*@mDdW;r0PI{oJ&9 zjUXRn*C{z{Wh0u9``adtwA;=UsVbIwE-0d4jo0lC8WtRh@V)YB>p=U>$zo~=FG9P-YP(8 zm5|2YuPPhj?ve(Vlt0zwM23=@P|vLoTr6LI4q;H2V$V0p1-TK^{}1_{l{;Qov5a!a zV_nnW8_;GX@PDPa&)fX6PU3P=`asdj63?Rcq$-HSAz4srF3{+NrktbQ%yHNw02iQ! ze_=2yw1B}Jqm*F8QKwP$I--q;@k9Bz}9NT zT|SJoM|i)hwThtQ;L*8bkwsU^fAVs%So*5scy(KWk0l6X6@36{j_gg7-8qV{l(7G> zFmY_}ckMI{^2fhwr$;lSW1kO28tDX?q_dhC`=Smh=#zj*JH@P%d9wGr=me*DJ&R#* zcE+y0R)E$MD|~K!^uYpxg?5#uqQgcnH$PYMNZIpCk9cqbAv^1h?4DD@*DD_j4c5j> zqKg780djLbp|Lq}yTN9VRVL$*5kTfwsDHwFcj=aHuqTg~;xnhijv!olyxXBL81ExN z7kUM!S@B}ZvgJqvWU=4~yJ_ym;+sdINh}_kK&@;{^_NvdqF+Tg{SO_$LgNZi{gp5d zr*0%&CbgkfW8EWl5_&$7Kj8|=X$TPOunRKDFys|k^XW-{@Ar1@G}n-UJ1%x|gMby% z-xZ$P8M?}sV;b2?$!Unyjf8z~rUPz5Zpopye1jz#y|ltP@G!d>McDV5Uv*4IX$$F~ zYJ^9PLjJD8nPVjhZoG|Mfku+hXfk$&q-XeK!od)bSxvU?fHIBVlE9Q+Q613-;jepJ zCm$Fwx1q@O8D7(W!&N}BQ&HHEZL@{FV0ZLL7eyRWquYh-ulLaw|Hn8k)(EnJ`a(Qp zL(gS0K6m1e@(lTO4*GD_Y`fz!563m_A8XA@z+a0xr1HLk^3EY&D&LxC4xhJ;ekph< zg_L6{W%;UZME}HY9m=o;A+jf);wA>{uBNQj|I2bCC#33z*@XR*<=`Vvf|uJ{fqJ^! z0xG+))ee2pH!e;rw3aEuqj#=P{-$7-I3~sv*8O-7@2vB`$ z?{!O(hhoZ9uYnS|uZh;9bm4iW_t(u?73m>Y#!h<|u+4%a@yoyC-ZJ2mkktBLnUovn z^T$=B$w>)v(_Y>LXzbX4KMIpOUI3JB`du+|@X+kylXV9cG@p&!cgD@*3CBhtA=Hh= zaCD99E9wn60hO={P?$L$&=Hn^tKb4TzYiCT)njZUU{k|h z_^HS~j1y_3H(%X8s*K+}(>zaiox^cB!_>;)02FYro$3Im?ZGGRkqi}yi{GfRJp`_X zTXuXpljBFe<0e&29o5gijo0v?_oJV{Rx+sneZb0nx?bbt?gDhu@e8P~$4#3E;WR<) zhmw1GvcT|8p<-z{s6~&WF`v{?J*`(xaK>%ii1N%%U7Y7mECm)Zg?G48Gl+RFo zb~7cKjccView7rZZX5{$f`9u&aEFx6)bL^A;cvog*9a&K5wM`U((2Qxg%e?VeO$W=pN6etKErEw!@V zDgD)FsT?q{hNH_JS6Xs9Q3m!w9M;CmgvD5n<9Cb&lSnZbYm9XaxHlb^m>JigCYwha)Q4f#CeE z$)fRJ9W~>rTb}eKhiXV17i(O52*_XpJS53@L~U8%VZ)JU!-*{b_t~LHS#uiF z=krhbzOB!!w={}r!n1A~dd47#)~7`IiamNczl~d=BKuZWybrhA4L43NwP|mEiky&G zMF8&iqjQgH!==RkLWmqV=^^pMI#|Ff7K|nzL($8YtlWdh53u!yw`KQkL#ji*y1fGatPcLow#Y@ zu2`Al2E{{V3)y|m5IYcy)Wj>L4gFx_erXA5vlHa6hyv+EhadGqwTJ22%;Y875}!aF zdF(;KqS^Q>B{;x-+Vx6K6a<+=_w(t_Z`py6TjgHezp)~tqu*$%X2AI4PT-R<%WA=7w{5bH$-aO&=oyh-+<#2{UagI2e>+y>6 zhfq6&oG7FpKhqLs!O)WNn$m;fUl}gXOpid8I2t)o85mfFU`npz;x7+0nM;MqFuG6r zs9Fa-H7prVBs65yhlIAjLB2Lt5v4@fTe^FVuaNfes@RZ<=z-19FeOBOO8J|v>!t;$sd`lAUYL0 z^U3TVcnYWBe4xdn2uM__wnE{a=h0Pd&1K&0k=$|LH_H(-0R zv4D!;!PUnT=qsuDGjCFzYa!JlEYFL00v_e$<#d@~60oGg4S}z%wK;~wyjmJraH#_b zGIwBTMVxJu(Y{uVv;w!Vh4pZ6y%y}-^P|>Fw@aWa_h214H6ssN_90Yr?llG15RMo# zHzG2HR696uJsUU!w#fj zlVMoLxDfN~OF^GuqjG(^_Nlq-fro|rwVu~b9rw)C?)i<+(y7HmHOJ7YH!kWrV6ku? zk6P`|Cs0&OI8qlr0un6b!7k_^*O~oYoW+#7N<-NLI;D&RX!(GqFkxc{gqU9zbDc!z+{O}Is}m6L zF}&&wbxYuZyz#`3P7MQ1E2ij}3-CTG^J}8~FrMvEwYk z_q=mIk%oxML_!I&Dc*4%gj0VMk8CYMX?xqQk+`JHrZ_1y?=s!= z1A)ZvPkp()c+r}k;*OH=7@e)drdD?GD;L!~V_DE;Gm~JVaPgw7-=@_nJ@41!J=J1I zKb-&^_C0;)P)Zp%X~PE>g?Kb*G@V?0vYn+sY#%{r&*z@j--ftXS`8Z+>2wfpVylmc zcOEAUT2Vbarm95))QFbP{5kn?-wF4;rEmbelYcp6;hCcuuX*xE-29+|gL@`#^Z>4{ z{dX_-sbxfy3B?(zYLPqhRrU#L}x%1m@e$YqpS{AGkwu&X36? zZeONs&V}wXEY`Zz(1bR|;x25Cx3N218dHZ6G;qIQ^C?NzcPH17v7*i%rzM5CjPk4c zuTSi_LKP2^5RikH1tn^oZ3ZL4Oi(i%W;=& zPo~^gP!6gg!`%L>Na2s+p9$yC&$nPh`#0?LA%zVB&KZc3#GH(DPhxzNH#T**?w(;s zRjoqzZ6^!UrBPpN=7=vD|LG=?&LaxQhPiKV#xNyJx`>ji!R^nRW8n}xtCNe^v9}I9 zbiP0`d+Y&iQzPzLv&P?+tG>8%ZL?HJC&C!*n~A*ZP8H!P5z+u&spbfZQjjuX=pqQi ziT+Jsb+cKACMX$&9k9I_o^OvyTcbmP1_u5#QvOJHBH zoZX-F@BD2pHWqH1JnI-D6M??2))NKktKP_CP>(7#_EiRc0|7Zwr#yf2?!k0-9ZyVX zk}Mt}5W6{Y&cMEbm3QJ&Oan#}t{p2t5RK80IvjW_g$A-ge@^h_I#$Yme6K>R?GBQx zSqO{m-PkQ+f_;mG>X(_va8klJ#>rkpuLiRbvAQ(;pLM~gOe|hAfl%rvIQxI`Q zN}u;5LJj3a_kV%AP;=Q}QLO&LR7Rp**o-MnI7b`%6vd}>VdG8|Pj+vo@9W-h``2lQz@(CU-T$>%-5@?4Z6SO*7~S8|CKD~Lg4-YXd|CF z6xF2Fu+M1`=JbD-2ChS4d0EDsI zjhq6MKLt+nP{dEjjy12u1$-wNO;DV?8JdFH;=f5xFMA1>viYb}^~0{8w6FQ0w#o2) z$~KEFhtzHEexWhkIMJN|KA3#_j#SP&w6HF3379YVL!0WjmFTD$F2SSm1q;E=$3SYa zG9R~CZYJ(KG#)D|3r>ah>F2aW61xRh+1&(Wr6(g z`cyXk)_{lHQYTmhuU8mobo&3ZegYH842Sr#B+MZ6r>bP_Ji)LOSv>I}C}dH20JRm+ zK#&yrp6)3;G({Y&lV+5D4fP#W{2DAfU`Y;L ziDa>)bpZ(JdZv08)mNiCWZtC7o>xl8(+6UXmR(J-{wG)?D%~_xl%F48E-@XWi}uID z86+WjR7b@Vd;scRBPPr$7fJq5>ug7uZ*0-96ThR&UN;rr77*M>K@47DWI zUDpO&sgar(pI@FT+Z%-k!TqG-K11YGhPpj5IK^?#sd$Ws7ogK07KDlt9_i8DznA?` zaADMas|}48H5Tw+!IAvc=Iab+ggAThpA+DBt5HWAhmgkr8|&;gM&>sM6EOE-K*WmRpf%QdVn zU<{8Hw9Ew#y!boSS`qLV!m=*jH1sT6&boQ{=Ze){~^7G$h~_ z7OI|q6)(K#pqN2H46{aNFk)h$Fk{5k#%$nL2^bR;)I#i4A3G~qu9KA%#pW+-@cnh^ zsy1Zj*Ho{JBN+Pv4F+zLSuCaSbFE+HYT`y+)r3N!-TKT7vs-wG_ZAl$@T|(~o!ieY zpLd|%lbj}s7Nwc7AzA5Jd#g{95;z(z^P5+mK-zcV#F%s2{1XD3sR{7_V2fQX8U-!p z&!fI0z0?M79m-aJTdT`iOUiQF8AdO!3&z+7YKtqe;o=x5ISU`H`D?6cDh81q8@iZn z+M;+*6S|*^iMyn@Sk8*|NFvgHVEkBQvJxqN4xlW#{V~eQ;f39k575cV_IRl3!CeG0 z>mavFq7z{_-j!Bm@dHBo%pVHXnMC+EOm@oq9gO~rb{u{^oCB$#EK2O!9Emg#;L=&y zhX}J^^Kc=VO8QZc9IY_G@=X)ub?`@OlqegT=nZ=XJMrV|hZQZirRcm((Y6C zZ&@67LT>IQ0MrUncL0XYe>NrTyhfE{8odc5TnN=yYP!`Y#(`S0{=)mGnyFUU&;s;NwF z$`sDtrNQv{yhH-IuU1#P(v46*#FT}f3Hk;1vUIIl-w;R4YmrG-v@{V0!{;}eKvt4} z1}1#F>Sf&yE^)vaa1?6}j89Xa0pH({&}&&Eqc)b7n-9Yaiq9(#c#dnIBO4Q2OYC?` z`5BPs3LIv@I2B}UlGksy37N%?#p3bR$HO<|s$J!FZk0G76Y;%3KVB!doY^+`kcmcM z8Y7s&M)~S)loF(+4FHi~43}4_zjp+kLpDY}7w^0Gb(SSP&%MfY_pfX#JIu8kzrY`)6DMi z<0F-CuB<;#CoJ}iyH%?plW0f(23^m&dT5~k(5Vvh3ZL!bG&6hNTZ z6Qzj{7!i69a5DQgW_zUczlFRpuA5kXp1ZEkyk6srfV*L^)|yfKXT4gv5HRU*1)jn- z904Pk6XM1&buINVU0qN?{D#~t*compnf5g6xt1XL~G7n)Cv=`8S)y@A(8gk#P z^T2hPwHOcn6)+bm3BcWy>Q%%)HcG(R=39q3IW1}!E?x~Ab#Ta3C=Q4}OITOMsa4Fy_l<^%0PYGUmwhl|UQSO-EVai9=x`BB!XQJf*|u8LO#w?f zP&w~u<{bc_l+dv6m$5haGoPis zD3|7@JYzY6#d%;qD$gMFE#0@OU()vo5zvS^=UKiQ-XS{E|4#)&KEo8zpPth{Ro>E&d+QZZIq zbMxR>0}X(W-zt~z020zM0MXDJVFs0_u9W7o*BU+hxNdV}=L*e*-|=+5!1;BYtXvR;K5f&6NzJswPrRUsiC}>wM7~!k z-TaRI4tjo2+)??oYu1fL%Gf;NF3#dkOBSG;==_*J!FBs@5#YZfDtA*l__UJ9M4GCL z1=Gsyh;a7Ui}!f3_o}*KeITV$>=z?KFQSbp1+r=E8c9vDvAw?9H6fES8>JB$Q@1uQXs0Fjx|cg2m*mW(6zmb4y?_X+~t zmMGYn;!<@9qDKumse<0|e53wEa-~_gUr>ns(g3nMW7m+(=gBNsa3CmEO6v#u(YezG z(2^iL+;;#FoLiYZbu|~JN<*;s`aGZV>{@o$mv?5{8DsyTl)MEOi}D8BeU2cUP>?Ww z0-CuEM^TT`{AN}ful_*RDgZ0S&HRp9UMJ!dqywlIg@oD**JL+p0c)SVehR!sWT%@u zx$siD%kNub4veZ}L?2oIe7$o@Xgs0NwZ2qxy@~Wb(8R>@H=7nm3=yf3Qd~9U#&^+& z_4?jaai8?i;yq-5d%?N7mwflikWAUy@2qDD15D`#qbNE6*J|rdnJObUJi#8@m40M| zHe@Zr;gEUtC$NRS-+Fd;0b`qi$&~}$vzOx{m|;gqs7d^Nz?M3n3PC>^fX(gf9!X&a z58Mdz6^_ZGV-z$eu(2uP;*D%_?ijt{mIh3ye9c>qr{e9;@xX>H@6W?t?l&mQQ2LU? zWFF}))M4Iakg(f(u$EF+MhZ$EBV@kR0pe9;pEmAnJFPhNioo}r7e-|)nWf2_WBceo74C#d>T!X^d3u?u zBrg4`Z+3E(&Q9Ac^mmclLupgNmG1By))Nj5u@kAcuWmnW{ZoIBxAB4GRI83XD+O3+ zh6PCI7*31f14-dxkZ*+TbS$)00RK-A3@7n<5%F?`2_mNlEQ+LOyi)5yV^m|61w1I& zxL>!-tRO9Z5N>wq+iVXF5z7^i*a7B2!Nv4rGSTfO-C}_uTQG2vi_nn4 z$w`_RbmHAw0dx@I@xJ@=5F`Z{1-k`{#{GIW`V=E>7_aC zXgu5I`^!5*JMKnaecTy(2LcK3i4glP7cM#d(qx{!Cr?$?R!V{`Q@I2AJ5(3U40L9eH0z^A7cW&Qj_daV?~<~W3{4cRhf21Dfr42 z(2$tpWF+Fe)iKV0G;K|{{S?H$^9GVZ-Te0^lfEOTh_yd^!|nFFdvl9_VukhXWXT?&y6UjX=|#C?UMOj-S&VR@5-iG^!s#WSY?Cy21aFX_^O@0 z#*z;wct+s-S29h{(DZ!9_+2WgyG1aeu(%QhYwrNHly6WvMiXpg9IKMFpEj3Vl#x&32oIM+PMv z^lg{LBC2};fypZzhFbx{AlCg8be6f_L1K!gVPHGo%d)h@3?Yv;S$OOE6N2>JU-W%z zk_fkNNVE^~^JV1^ahn-FjVkeC;Yy%Kz*ucYEj`rvu2d`#99rJgR#930h#88cJWsP+ zr_1~(PGQV=5YvF*fgw;czO{R^DxXsMC03oac3{aPi(ldV7b(JNI2gyYb9{<*I+>Z; z-6q)s>Gq`}VHF(!EKubE-+PXKGxi0vv8iRA>fupbV|A;n%-@&w6LdG_+L>Rpb#*Eb0tCI|#I@P`DBjjP2{bAfUIRlGk|D z)#;%D%rPnxPA_aiRm-m3(yV5dHdP)&!{6#ajl#=Qs%tRqM8;zh$hyd34kMDdb+16N zn0LF)_s+8Yu+($xhi9es??b3jryAczdd!rV)7%#rw?h-(E2iVLA$8x(jjdmEnE`A+AHC~!mE_)$Y&Ul}_U{8bYm)b=!eCgl z0SKLptS|507@8xDFMPIQKs9$+0h(3i&GN5DO`^qS|ARKGH*Ki-M;4#xwIBSNp{92V zEq_ra4dICfV25L1g#9M-)hrfaPeW>zzy{Rk57fk~M-$YPNfdcq3v^(cGT3z!6N5Wc zd6yKZJW@_p81`TXk%OH_y=ts&x9U{ofG08W`Cf4cNs;^8@{=5YhI+E=QLnwyd;Z_S zgzMKgk!d1eOm>~!icmIeNdRx5Y;_*%zMk@)pBPCEKG0k3k)-Ej}#yaPt+BDyN|^m&pvM|T$EoGC++sFg+RI_l(FZ802{ z3@XM20eQcxPBT+Mqy2)%H&n1=@2v*%6=Bb^mnm`-iRGe^rtGOwQW%+>#9LM6dyD$d z<7`2Y@B|~%_Sh_gI7FM-M;QfSIG!7FcW*Y{l;jY0HZn^G^(@Qb?g2Q^>UwqDl&H7n zIiW~0;56ox>}3hm8SB~nFtA-ajlDcq{ni&Q(ora|E{sE3=R74p*e=V06dX*T+3kNw zrCz8qv9)KuaE$L(fzHftcC5r!P4nhM1_E$irFacksM%;w@4pyz&wxo%1BP4h_j zr_e59h=*GhOh+JST`|W_GWBoe<5Pm>2Jb>-Ch*GGa6lO#q$eib@(rPJ$}{HR?(!iw zgUR{qNmrwUD#m5$GQBksCKoxtFEf<}%aB5!xJfyvtwjj)m#0i_z<|106-dSvvfIepYv$k>Bk_|figikb|5Kq{XS=;#`TvDrU0{7m#FmEk~J*j8wa_k`e`0Ms%`~O5| z@lB3Rg~a!>er>g}aA`cBhh#_1rA4e`K5rn(_He~9PN4I1>sJgbsCfyX*Y7jQ%@1q9 zuj=Q~4;?CG54DDJ8dWfMILwPyD>ss+aQh|EiE~v={R9zSn$HCRZ~&HIurgz9a8$Wlm;QAY z?gMuD0HmKwc@n`=sISU&4nV$L(fUcc+S|~q-%ixsl1VWjY=$Ov+BZr>qO#<7qa~=sqpV^lK&gz)=lO}zLt0eOki$^1wTJzkWp%GiXIuh* z&1_f6#5F)F>3nP!`OI}_xxQRBI#0xD_20Fs8e$=Z*Z0B1t;94;2~NL>ij;y&f=y17 z6uOcMI{u8RG#dIbtVUh7Zcp8U?b`%=@|2eLrHOhlM;-$A{+~9k`w$shXk*Qa;ld-) zEeS~Id9Y_53zq~O4a~@3prO@}Bfb;ZT2&|o}+%w;ZW$TH^@~&JEa^#>&Xcdb|?5Vh>ga{(3v@IF-4?w7CwcOE_ zO)*+9H}M~P$@UBTy=$Y9nJgif&bzxM&}Svcpr$PNJ^)Dl37{LhR@u;5O`PN4eB=Z6AV)}DHDt?dnZ7l{rPFk76djQ$D!OJP^G zKwfm3!%7KRKh<=>s(i0v(Mnny$6)k=2I

p);R5h`-t*ikjlJNA7dIKiwgLCCQVV z>TROYz*ATVA?MNSMMH8QVjm?ZH)D~HVOCXU>E#z;wOV4mVS0~Hd`ceDb*W&86=eP} zKgqZ+)ee7nJi!o91s51O$bexuO1SR*L2nj&N7qMutE-bD z*q2RLYj!^+35=inC;XNW1B}QMAG0N2*|_DO^<_lS zJ2*aGT$Fl*;IcwalWtw?yVg<@7jus*$XUQMXgKTW&QW|@@a*h**8Bv8wWBz_t0Xvo z`hH2c59^UYd>^;tD+bAbBy?+|&oyuGae%Ki?1$rX)$0$**8n>towB;#iVHh=rh{<; zfTsR=5N}4b@H3BN+Nxo*I_%GrLcXe7Z^iBt_G07=K-=3TR0E!Bw#fQrxx>YZm zs{byUw_$>t+=vl@7qMg|C0F)oRmMBgfKXX8GHx1MUA}`uNPb(^&3(ZVD36vGd`c{r zp#7Q7mu8NtM+Yu03w?|NITpmi;MCa=8}jJv@JpR!eRm>qJA!x-ju*Ikg3r47+fgyll6T+7c0#jl=xQUnQtY?vB(=x+KN3oa3SNk(vkl|m= zxk1wn{5or{em@(Rh4bHXH8UcynUDbhA^+Z=yRqTTyc%)Y*CU-nkP5z{!0wR)OHLv? zVIAQqX!g8#Yy;p&n^4-6o0ts!l6*gJ*=(i;1Qr#YtlQtlM*2Sa0n~wg7Qik8REgej0J4PHX}9W#u?{JtsIzOkuzjPIJ=h>m8r@NFQW$y zdpK$A6uULGT7tmWMO6v!hAmkEp;g$!z34N(+~M?e_Ed9k6+gg&vstjp-;vBt1*m5b z&pD@k8kWa@6M~zg(V1Xq<-T;>hJ6U>>M5M-c%n=zV0R}$s}E~C0{SW2Go`i4~N9mNTj@*)#wqkH9np0^8FLQV}rLnv*VjD%g> zg8n2sqxtDK8#3};=lPyFDfbR-3pWBlLe44@M_G;e<}2D|eNP-B@d|>eYk|JY=Cbv& zC`C6+{&wTLD*O+vdG*dsU8RxoH?B~?u_e-e#Pns2Q)Udh#Az@BRqrH+$TJ4_lCj`i zS`2O+HZ7n?`{BooI`ncmp%a@i=~kH5_V@y{0RN*ZPMw*Kt+=?fpCXpB$AdPtfUX~KDO|4=Na{Z-cdT#MgB;# z-Hm>{pSMRBIFeI2YH{r2Y5zoh%{ll;C!QM@!|!OM{D1G*H3zUjKn!*qpf^2$!2ahy z!f;0=r>-I&uqHob0m9xjk{R8mhY5pNmx@%Vun0TI-o8MO$El_O(vKSD?F{<1PL7NcIi~GPm_h?G17o4&GUt7i!zRq9PyKctOGR z%4!*Y708W-3uJfjm*Hr7#_g5w#Gq(u?@xc|ZI=6AiyOb&nDR1zq6|RMXVfSGy^?$Y zYz!F7zI)|Gm7ja#)28mV${keiON$l=mHAVGb;Czfi|5BuN^LT-maf}TxrWs7bg1jFRa23KNleX-J*_vliL)WC%H6X5@`&Z?!#i)n zQ88Jwix_@S;ur9zPOxdIAC?ptFt~C8>*&08jNxazI=agI0TE-!8b*Rs#{9LUz2~3! zf9ac83E9PU)duJ>2WcOLJ9bcruX5Hd63VaNonU_~UNKcwY1Lqzv5Wg_PZ}OpYI!2I z3wvG_BnA;`s=t-H^t#^0aIurVXTh->&f2}DIpsQtdu2_v+2Wq0LpY&hHu5)bCYm6@ zY>C2~Y%o#`Ocm&SY59(5)p27oMlQDvc0LPzh{$kJ3Kb4qJA`9Cq;o(or$}wxNO`T2 z+r`J%+WNUK2FhCUSkGwIJ!%7_871!T7VzLlh+Eako@JwZ}G>+ zds$x~hsEVgxN=~RMZYp>^LJ@8j6_K|5kK!GfajcKC@i=^WJ(@#3fZi>H+yk0OSVdq5JYrRYtuFbll<-wpj`zE{gEZ?VaQG1`D{rCx$1L z`?M;wX}`viOTDrJJ3cazWe(A*SxrmKMK{*;|3n|GP9h9+0D(WB;{V;G>KsJcR#xkF!wik3Zs5PLqPd-Pn)UP_tjb@_RjYZQLfq z-$gpae*j83aua)mi_#v=ew#BIV&^{Q-U$`lQz;T)lrKGxKM(Z41KN;_;qvc1f5Mg* z`RD>gaRm03VQFu;L0U$RygZZlXI>+}fS6&o9+?w=X5(02?lp)0cW8Q5v0}!82wmWu)CZ8F} zx-*>|_SlMmH8I=MDoYpIn#`d#tK!4DAQB+KDuiVB04mceYzy<@|AZ=1^LrO-z@eP5 z(r>c%=)+_##3tf{dGgAhAYr5>0naC+UOTJyF~Y$I-%(9Tc@hFwq~eZ^Dhi%}Q6Ri} zySvQ#P;6jnJn`o{o=NZgEx#)$X5EO0skARv#Dz%fs(dA^kn*)XnB2vzAG4O(f2{?X z-;>VZ&c+jmh~>6+Y-gMF-q9tvt^5{3ZdzaeT3&oFT}iAtS7IxbhPbXMcPm16(w;i+jm+VER&68jM{W&cE~W=)*gPOqtK) z@8u1}xGNR-2+pc2vd-7V`Aw1^U`56WR;1ERPNAsvqH9V4jP{b&6!#o!7P%erl6Z`^q zH=(t-g>lKu$nQ)E(rwQ3@!#(qclgO!VwrMI$5->2mOs*Fcb!Yki_pohG}`eof*N;aFQ!ePQDc6*q<*ky-is1Jgx=g-@m^a5L-mEJdR+v*q`hUdqi4;G z;4hv#xe>)6BC$8NtX9}?7-@W1x9hHC{V&lVOFAg&3u3Hv=vwr4C)TGzpp6dbLBZ(c zt>dd9)-~Ta)0*C}ZjFrJ{$59%#&rhbH-ev!e7Y_uoB_KJdqJyv;Q3EerfQW|0I}pD zfrj}^P*i+`kYp@cpg>4nCm<;iO{QE)9U|O%Xbs68tFQry(!=9z)X$?=P3l{T%$a&L zHXs@zS*(eox`T|s`@F?m5$p4Wu|VrN6LKV#viJs_G9)%6YAYg3`AH;Pj(*40IvkTp zG_T`YyAOhs{tIr~ttMP|lwUe8Lpqz5Yz`{~?8Xj!YGGZxug4Hs9PTW|H{DeW4|cEP zb}UDxg|Rr!lrzGV277*E=lS67QGB$@hP$(wv6Od^At&=@wpkU;Au;zDEOQ)J@G(Yi zS=iz=T00b0CL7Rgv5{<#f>(hpi`eXF#~q_5vD+`Q3YuCNaZCBj_OtU>Q)E{Ow@iv`kH#?nrk?cF| zgLV0e3=1{g90DJ?GYB1;hHI9K9T<2iIMzL{2arFh0@ zZuFIx99hrco4R)rsZJ6H=`Ep?-s3A9k3GApd+G_-bh3%_WHuCn3J!DDZwoYD`*#B1*xRfcunPtIZ#F3+k33B}H!0yrdPyl-a znb(oAYlR0!y&O3SQ!J_(Z36vts7+452{Z!qXgULTRKWC|Bm5XJOgs__bPG8HZT`}+ zC4uSnk3mljlkPJriD5nzqLhgnlW#YLpr!~5%MZmkm_==I z8^u=U_05%xeiHaYo1OhmQZ@XAVDtbKIfF}ZlQTDAynPI!Lsw;kfG5IE8*5#~HLMBI zd`kDsHo;&b9>O_?91rxPxg^(RUX0r_z#!t1s}1YdL}-GD83k6|_rleJA!!qsFPsX4 z8xb|9Tdm_l4z>*`qbSz+lEk2#eoaxq884?PkeCBj@*)`FYw1eyqS%pX-ssTt5Vw>B=cpmVx%ba5X=KO6bZf74L6wL zNr5bjZ6=nc?G#Me#kQmN`Ldj8k6&1ekMvV*gRtE{v|vP!R-HYrIG8I;B+fnOW5$;%OR_uUDNj zRrYl|F;q!q)z_iLHkpXg;u(tgFpYL$Ak-hwXFwx-9m;oFJ=rfXP%K1zo*22&|Mb|3 zQJG`ScPzwr00Se;$CTZnl*iOS z%BRHIVzFpQbCV%l$65-@C%PefC;W6{@>Y~8h7+uDM`zYo58)a9`1y2eTsuMyJgByd z^VuTnUs@Q&<_*G%0T%K05nNRoD|C8(OceH6w0+_RKr9YGmjzQfCe^(PZ>XVekV=R3 z`|s)ID8dd06Z>%gyIEi3n6T@~haMXiR4pX%1zf7{ePwDzY4llDS(FHf6RsoxB_u+e zEe1*xVR~4B!t4xQ7Ko{GlP5&4`n0l|9pNZRmPA7GKJ7SVhG?RWTdnYif#D?f{I!%W zdQ6%eSop)Ldhf1f2tR7o7?}~2<kD6oRFcb#oEyKmgH=K2 z_BWXGzcj9~T4OU*Xe9Lq88LGBF2>?(SS_}6;;F&x2w1rs!C*E`hzdC!0NR5<4Vm`Fjy3TL37%NsNV}OG?EP8)zAb-!H>=)^^65@kve&;CU_IP>Yae*n+Q4fBDm|V*+mvR8kcjhXJu9xAAfOhXNt3h@+ zowtgvrUoR{G?$-K5&j$vt3_;}7;tkT?7E8d7e((tXndq=&Qkz_cN!RoDv_h&Lc9yc z5QXt)t52~JU`E$$KurL+!f>lE?t~;ja+QqM-a7`V%`c>X)b?6&tUTMkA6daV8!wZz zNgi}Pu)IzaDP0aP5lZmA?3*PJ^tXd~Lm#ub48aGos-EK$nQkiAf_^)f`X+nG|nx5U=z4rIvW39Gkd3jJpcojw0$6Ez%Z1s%ees zgW)3txhuQ;HX-GA>twF)M#KAO2$x@PjAzv`HUg{7viHCj1%cRdWbD;#Fc@S>;^I#5dM(AJ@*-j^ zC(kts|C;f5eT_dEWGY5vZ16)YpJj)W18j+4xBFjJdT!!)eCV{JYJ*07HAwx-v5NjZ zZ_;z6ce=MC+eht7c$s+C9s>J#BG?a1Hl!0>m+=BlEddiz1~J-9;@I_WOIC1FQf-+D zIZLaeN<6~>d@!!Opwz<6btE>9BhCuU3ELEk#zE_s5~dq<;NURn0afK{Db-^iy`9U< zZi+lG_QIGd>Au)z;|o&WE)Kv_5@QW#fl5DBO99QjOwA?5;Q z^@J-lIKKNTq$9kidiyrE{SDdX_&T#hHl7q22NWXxbu`SOk+3LJKb5g(Axj7taPpEC z&QEwlnjfJy^8;~^`SSs{Y0wx4w>3;=Z2PjZhQx%{_3&&C;_z95;1t1G6_?s}eR=`R zp9WRANxIJ!#%OOn zn57`fb*9AWIJ{fSM+d{Xk0Y2c90sG4zVv?k!c&0q;!}=4rCa?n)>ANfd9)2sad6f+ zS~BX}PDz0MyvBNv30vZ!)oRZ|dczb8I=|prYjI2KqfOEkA=!Z)O8^U~+Fjlw))v4q zO61{D!=R5>Qkf2dVX5?J%*vn>T#&v}#kMgInzHILvUBdTjzv}K^ZPi1?&8!SCQ+C% z;IxlhmN6b4C5yXSZ48gsS%W9&L)N_9(oggH;w zm4|0|ghR*JOgnv2RExrj^oX5)_XE4Z<~GH@Zk%Yrve|tVubEf?ET!a*_St#C$cWBj9^*mWZkVlculj;DPxVGtr&A^t*IXp0}%>LXFVm_hnTc{)PjY<+kAy?T&*!{ zJ2|<(KoJuo>z4Q(WGG@z?CO_i{aqq%EsBku=C;I2Sn=BuF*g@26!MC=PWilARK7|8 zEaqPb*7=@W=+e=~Sk!OuNfsX0NpYJd*5S+xmyIa%MfFavq^~C&dyDjbUprH-n5I}K z?;+jT#u&xR+ytA3gpJzM@h17@IPgfv zIF~P1_maB)k~DKJD4YkixEUjUj24}Q8=jzGm($Jil9daHO@vSvLL^vrmx<+gR5U<3 zT!1*I9d3w&9H<>#W~HpeX#JX37?>Faro&1{NBq0b*mAP*dh1Q!uIY;GgxO<0#^K{M z$~&(@7|I$Zt{EY<`7R0})eC|XuCT-Im2_ajLy72?*?>C)>>WMUrWtOr;pBZBAqtQ7 zAu2I%^l5JGPl%(4JbQ0P@l+BV1%{%43t%JuIfaY`R{8o(p^CVwK<+;mCkDmo{ey_* zR%{aPHn6J6;0Ba}q{-1Njt6^z_|5WJW>g@E9#+*fZ4hglHjn8L-cLG6Amnsw|9#tZCh-I48dZeSumYxU&cqMG|LIE+gVen3D~RB3#Mtj5F-;5PhRz!xG-W0 z+SRHW&-fF0%cwCa+&U;Xm^sMs-^R2P=o+}TZg}R-)zG2H||`q z*`fB=q;6Eld$eT&6BUD1y@#f*+X|%FD5M89`n#MYi=nN9p9x63e85f;dMcqUMqYAfQ(}YtxnOk(46h2#@_UA1Rx5$&G8hdt+6Ku`9LStI#pK(?02a zcuqwuQs<89tmnZuCV)%!lgDH4jv3~EEe$v# z>rbTzkUdip-ThB3c8)qmM^GM=d2>0 z+s+KU%^;vO=B|+@*||M7UjSEkIA_s+%}*Rx_3&qiR|h$#0dUFO=Y|*V`p0?8?ZoL? zf=njsXm5FLWR-&`eDE>?%B+c0dtL~B=y(s*)HX)6?)EbNFo&n!Ei`%RO@mRbX^Zi5 z;E$0k>g(I#X_t32(M8BzwOLkrnLVB)UayUopv-}RWq;)pf+@5~L;FwQA#NS?CthS)N=n#N;#*EC(dPX*{Cr{+Jx#31nlwa;z z9e>xvUT;2fV1Ji@h!{3tsnuDTBNi8Yazb%E@=_PL@rN$UF4LGc;VF>k{}f+}gK_j# z?Hq3CfcD<3JY~L|x;sgD4}je<(EZcXRY%mM9wnY~iTKY$ete7~+@0|5hzf%%$}KHW z_Dop+AYj=^ah@}1)MxkQ^Y+2mEG}gM@uLfq4unx|K4oM^2^ODvlPBjOAOx3X9)m1W%#V=B@NqCb2mb)4YZd~9WA`KCi?1fk4xx*u zgA~Snp4oiA?L~VVacrB;_(+z~W5YyWK^c8p;e5pFv3;ixHz;m-R~WV4YJxt!yyr(H z0sJ|x8z|f@+%RzTsL9#MwUBn!Ux`(-xxoX2!m)b33X&tq~@_7X8X5;Sup3E`Tv%8(Is7=EL@*N z@9hi6C7YP_@N&-3wHUm5vg1n`dsF^$^bC_w%*tjpA@Mq|FY3W~QjHuR0ao9Iw%jLfDS=;o9sFEL0001gl{@7C0h+@EmxL?c?r>E;Fb#_W000000a;o; Cz~q|% literal 0 HcmV?d00001 diff --git a/data/bigskate_lencomp.rda b/data/bigskate_lencomp.rda new file mode 100644 index 0000000000000000000000000000000000000000..6eb32a50e7e2653c6b5a03bc05c15f8ab965af8f GIT binary patch literal 56668 zcmV(nK=Qx+H+ooF0004LBHlIv03iV!0000G&sfamz*XHIT>vQ&2UKVgRpfklJ zl5LXH8q+8Uu*G34G-w_*aZvphLXQqy#XEllPy5zGw?4UrokhcWB|zcHmkaYUrQjf0 z@ak&h)d&R#8BlDgv>U}<3324VAacQtqbvyy@cd1`)Gz>0;C4$4c!ZO9saqmgYEL}F zJ8vW;>R3W1*4?!5KT{s(4EdH!yb$r1ClrI2JFW6Ock1AHTLEB4Kit=o648Eg&u5zw z%RK&GbpA#NKg2w7m48YZ2sMqgbbs?B3?zV8Z~m_~ZU$?+q+Vcdd;)8d)E}xkx&doq z>&KZLwO}W;de~M+Z1p}x!CB6`#J`5avx1#z5N27gfGVHP&X^aEiNlJ&NMk~PxqrH0 zhnv9gh{n?Ue!l#5pIkChg_hm)=lpwCRCQUHJ}qRZ6q>iD>YsK{-$XWoL~3p>^#ysT zo0i_=_@g~BdlOuTdB2{Jq|D+K8|Q$CcE@<4U?`46PyrcKHC3h(ZqEPAHG-o33`nE) z(LIU@c227*hdAaoG=x<+S0 z=}k^y@OEkzJ45cBN63doF&?=9Jme=TtVT?-+qc#@626sFL}^rZb{>phQEBR4B#_S$>Q5fIcUzPQY@=OS?&&s((Et>;Ajnm>c)2{40VRSrx&`_)Pa5@x9grtDvkB!@bK>yz}$~ppKUVR3SUYIMObh_HOtm zvfj zQTF*9|`LhXw_7p?!VwI;OYzS8T1vf<`tEHXufIUmSKkwF#I; zz`h2=ZXnF$b6}KBBRHzX`xP2cd(?P4TUO$FsTis?5NR~lqm6581o)ldw zm){*s&oOgmET77O71t{#ofWXybs+#l=NYA{YM5kaJMD8ibBrbd!{^H z<3(g`7^-TS<@7pon_F9?w3(P~B8E1qr)F5W{fJ3RQL3cb0T%HHYich#kG=!Zha(9O z{+}v5fq2~bfkujw5y$!F-D=={_XyaZlW$PJlzuDm>T?gV>jqhFO~^#~+oXHsg(@6j zOao1wZ_%$bUJ#zku!yAbjdgkxG+*afo(-a$5!J6D9UsBuHdl_3x){51bLhHd!+ znx2UX?;unczk*G~jY1soYSEUY$Gf~m2luW$7a7bi(eYWteo@Hc4*=e=@N;!Ty4)S8$~2(WFL~&AS-fBC;*{4v~4G0s0Fae#~EK?QUFt5d{UIigTKP zj#r}nt*6GD_4C=9Ww2HsVZ%@zD?F~WQE`^FdkhP)*BgMQm$8+o#3ZyeAV0>so9Jl0hvR>6{= z-=y&lkef%TDrWW|^{}rbyvd@x(ype-3BFnhwJChPfnaW@-6WLvw5^a+r=@u5qDOob zaVuv3WyH|Jmcy@^GGxi=>8kD9j?k?K2iTm54jq)Lp{%Ij3BOy!xk55@USwxL4Ba~q zji;kgzzWcwYg!TC`oZ72)ez^FQIrN2kWdi1lo(-7Hc`#t02$o7Y#1 z9YuDli@@&+mHrk;)w~nwPxPc=Alpj7ZyLm6p15WNT~?Uuz~Z!+OsceyCf!X(!46E^ z9zVUwMqw4n*?V5}`>>+w7SP-TM{LhQvQ5S)3N_gpZen={Zq=>90)cGd(s+SC=>g;} zoW?Lxz2{2x!#BNd*AOxFjUTe~{l7KK2Pn;)kgHnc*j0gv1g|NnNks4nwKd$O25j~3 z1VyUDc9;X%sQ1kbJ-20t!KWV(?KEU(fusb?3cDj1z^LQSS8cnpkfmRz~z3rROL2eed_iZVSoe)k~%S?}Y08&O(0GX8Z(&K{v#^eVmaX)QYdRTb2f7oeR zCsf0!LdPe`3M$lw;vb-CNgZT@HZZjH1(4a4e2-ge+aRLjH62*|V$y zv0J>MM;%Hk!}sQ-Jn)bqRB8%)`tJ_Oe_Y*W;gUiLx^ zqzPsK+A9{be5T81{j0_e8hAfB#{L{_%a&oe*jOhD#^67E2-1aH1=)d?&p}A;F`Zi{KE}#WLvQnItWktAqCHm0NYpx>J z6kn`;%jPWwY}JM&#`##26Qg{t|709~foKMAIN|NQKBQY$#&Y)MmbPm1Uj)>Q$mQb{ z{KBE&;+87EHIdx8MEIbCj`$m9c&M1*dRND4R(g!D#?=Gf`hTT05)sPHyJj$J8R^t1 zE(+2?r5rVv!hDxW>H8JP9%GEEs8dXSS47X6jRH}XiJu?WR{|J;qUsSs5UdI5Ti>+* zno11R*eC<0t|DB)PJUx#oE?a=CoOD2#O1CunuTra!GL7a2!STH*V?|zAzLZ0SGvS9 z)cYKV6qnWo6(B5N$$iDqFtz-teO=mPtwSQ4n3sG-ou7hV%sUFdR{?_q*+NtcF7uYp zs;DJPqmcm%YJHrNyq{5hbaPph9VSC1Py(T}YE(UqrHAQ8PCgxf=LG?W3Mo>io z3@umo@J~?T8z?~;`odn9YnMgNuih2ySb=QYU;RGT4|xA!B8S9wS#4tu)B<{meDi%y zm0ExN=Lrt4d0t5|s`SrRkg1#+*7on3Hg7G*-G;E3$|YMg1^S)=2sUBiNRwaU?bh!K zA53k(6y#r?6DHASX#lsMfwE0x7Q9-(Qj39kFm(Zld_+oRL6{EJN^kgiMBZyRTcClV zhwVBB^C9v+@l}>BTPN#5Xti`{d$5)a)u*R7-Ul>P=cn{$YTRo{S?fh!^frPRrriYM zVMVbiA%@_=9Cw-9z`B`FkyyDEBmz~=U}tGSIDvalMz7$~3RP*VZ(w{${~vgp+^-W@ z#na9oL6QP5cw3YcJa$k+&`<_U!cU-VtB+?~P#B(++QJ~r=rM6uc+}4q@cKD!lo%dE z44e#7;en1CSz-ST$>I+6ztcnDZqw&Rz!&OC2r zEt$u+)jJjvKa-5skoLJiTD7VRGBMUvwnwREl`1{e%tkfHC}FB}763(MmTcx@L}Ke= z{`)6(gZJ!Eo9hLGgBhV2nxL5|JR(8d^n1^nbSTVxVChJ}pUfX)wc?78F8cIuL9$+V zb{ZZ#eRN)kkL5(%>&K9F>E1W(%#=WfFip{YTKXwtm88|r*8GIGY(KdK&Jub2f2Boj zwyAR#?WLgno$er*{(!oBd7recF#9Qe*TVyub_F+=6S_` z4~t6XX=>&&WlJLJu^M}FBsA;=`m<$SsWT%(S~#%`{d^sY7{mk}T&QC`+6K$hj}&P0n{) zQAN~ktmg(}s4&Au-h|@~-N1->ZR6lIIb}}Sz|y8-7Kij2@0I+8yx$L?_HzzL=73mZ z)60?Aa431SYu)an7Oce-6fTf^XmpFI?_=F^J>5?NBEjO1~$7h;eo zq}D+zvL!ID;K98!OG}egtU$Vl9&$;2q)y|9F66D_Ndq4|kFB}MM*B27zm!Ozulm3< zR$tG6KqAE3U&DN;u>VX(Ig&%|SKvXtu`Wr1;&NX350oU{>iWP-*RI-NlmN31(Hw^Dv1H$v*SJNV6pRTPMxG?m?z3 zmbgjvQe@|o8kSFF4==)mVi)^EVX?EO0SOiWD=La!P8JmgU`(arX9ClvJi3S?;(l{1 zX|~5g*qt%#TkRnzqpo=HL3)|MPW91;CNg8I70;$P2!-l6$?p)8)VTy{7a3?FaFH?^ z?i*5PMv}3^`_w!E;b~mTYiN+RpF?bUOW@I6TH+bVK3Y`-O)E;|;FNqLrxZTBPC?iR z*a$EkrQaY#LF0w1E7v~EA*8DcV}Kf*eNVA@e%RVjI*`z*e4vJ^Q)@%wvhZ_?x1^U2 zn--#5b!-S>EixBQeBBb<;I%_zscN3@v1V|03#twsd+gMOn0+qHdR9(M% zF|LN_F|iK2t@egv`{p>ab;54lzHStUWJl|ey*7YC{CV~YRq81D=t>|42$}N{=3b!TdPgt z!zaQ5cJH5~({Z7c1^A1g$67{3B8BSTV6I%Zdx0v2$u`$lBYqzJ8|=K6pMgr|Nvg)^ zv}bu*CG}+h6K>*bHkw=6a6Fzg764{4BF6=r)h0tCJ5h!Z@eQd;Vwq5EkjPgHDfq1r zjBy}*w(pEF!>OQ3Dr0`Pm7E6B42L#)37;V7KT*-@Z>*Ob!a`z(<0hLTzSvp&57L}1 z>J~5t6ly`0=Z?lzC(p+Bx%F)_na&T-p6H^h!p5$A{#42@w=P{tYYeG~HvMOUO*GN8 z2I8K(Q8yd`Zv&+YdmMxlvy|2{ya}X!PbBIAv5enYon=}Ar_VZv0r8;w7X~Vcg14WE zqw3Sp!ghrs{!le7s8i9Ch|Pks1_U&}k|F}34rA;R8XF|Jn@3t8?E1jT=767n1OW=s z2fe+$^}mfrK0fFq6RAl8Ee|hbM1)3MpWU^I#(=)$ep<(DbbL`Z`v4gP-#s-|tL@-k zNQ>ab0FjPaa4CD3nB~f0gDT}&QDkLV?i= z3fU!OZ9kh2<0Gl*I66Jm#topSpc3rpRwvxN?D^J1E7d{;HnQ<*oDcnkop>OUVT`{R zO%^C%{=~y9J^XNKeX5TKp|B0L_9(RJOauFVfy$tUT{YM4rA2^*;D7fA0$UbhNiBg| z6C+>qo+DxP-J%E(d8x~51L96Jj7?#;^W`{p*C@d0e`1*(+>eWDPIs0;S&B1klPV-B8@4CYl`&-k14**=pu%9(IbM8kDT#>x}EkFC}+RZFHxNaTDF7iwHSZ zRjeY5s`pT2wcDPN14w4tOC(J$oug7PzEV=0^xTTnrNzjFtU1s7H;=q_t*F8DlLpAA z=FQ&dsSiKtzTpkACH4ZW`pEXL3e*+Kr{7zPe$jK6Bs7o`umEH}zj{peObas?FW@5FIo}ZMA`IEg@G<peI7(!SzrAqW!Sovl$opVt{JnkQ9UACz|6CRurnM<(_JOIZbDeKSf#76PtXh&v z_nmvqg98t7FQ{$Hi7{^v7A?uH-w{Qw)TrwXKJ&KJX|xLXW#fA;Oi{K@W`Bgx50z#N zUSDygnt0HAc5c#{2RYTxOoTorwLhORzm2T~R$SDzsl%IoBtO2b>Gp?g)tu6w{GiX( zp&!h5S=`hhVK9Mv7D(U$C%4`NA@T2sGDY85g~xuAdQ&EcmwBc=D`hdFjEO{|MAuP` zhV~Q5w5<~@>%aDqWFS}Gt^}fs^%+0Upu^IkoczV8Zbi?HQVGw&()MZCf+71|}2UL^3`PErAuf1JyN&TgI)B_$``bC7x z=89ZykO#|RUT8)~YL2TFVjC!5wQocRq$);=R&hu>dm#tI7n-vn%v2CdK~j65d?P7& z)@ud6f8UFdOd#=x2??z6WUKvbzD6M>T$*mF{ksUo&~DmKc9<4Uar=QmA~dN7D1n7) zj6-=ztWa(fX+BL|tf&Ah_imX40lE*as0WaJlDUHs`+N~c+rJd&2o0D+r)1dJ+*5b0Y5dUs6gSTR1*())}=QX zX_SsT!p z*3f{_akRMBX>fLf0`DacA!#k6iOYLID`MNXq$r^p+Vry{D z9_NeJAZ?GXre$$)q0Q_ezWn8#9482mr7=Z`V+>gl6)JyI4|MZ)vPRXzW-OEdQ$_0% zI0?EYSL6es!VbR;wCL+{7eXU(~|Ks8LlUfP1D1AQ!M+wrBQ3UseECFU`XZQwfIKqIKx1--wZkRjQ82 zarE#9zr{=>=60?uIfE{?YI<1ztSe1;66PKRBRozoih>vVY*jIfyZjF%MB0KD@;hDa z@GjAx&VRgf-6)te-}cJ^m~UzdN11wgUj$wu3?iexCXPgS=EN^eL}@( z7W(KrCQHL&M?Q);*$5I!W7e+%axZnRZ2stFuu-5G3K_{?TpVEQae;J$4WLbZ?iS9V zkYHrxT{;5>VE5@6z5J7#@3jXm@ebqB?vQNN(h+{>FZQc2zvwo?JeZ=9E zQ>jorb3sPihv&uA64Os`yND5V9(<>8#=lQMzWKZ=VBC8u(s+kz$_S zGzpK^NK@mS#=uWDN7%^f{1G&1{*L_#;s@J??ZsDT1bXDT+|Wk^d_3`yq&gu5V+{w2|NF;QWUxc*rf!6 zQW7xPi>gL|aO6>)DV}HL;F?omwgj;o_%2|RHHahvJYT7kv(ZUxNmMpIkI!UZk%*}@ z1TTDWf3R&mH>C7`)cvc;u~2`jd>;gK!`nU1mfSX`re!`W`YEMB!AO3AiO0PqZ}Gsq zv5OW3*ELf0k&BW=^^l7~Hcz0V0@@a$Z1k@z9(CnlRk3s-14nTD^WbY^_=D|33(=v~ zy#EqN1?JomZUuq;hqZ{LNdZs#HRuG!-YSxZ3SD3P+dw|9wwObW+zIEDXNlt$5U^*d zY*7dP$k(IG2m_4y1L1!JN3|6SrWRyc;i!f&c3!SJGC%*?{~#LtNqH3}aFki^h&G|O z`XJMy*NJ&7ZgJ9oR0j`*;2c`8uVX)uN#sft-&pu3EaU8IsNEL{|TNJ_F*cs9Bhcb)90>rvm?$LgKS}eD`>B{8U zUO!#JJ1CJr6XnF3LpgxcH<8M|$KUl>s|L&Wy^^)b9VS;az)zucQ8Z*&JDQ>v_b=5H zlvW2+gWO_HlUsDT+h?-!3HPq%3XqC7X=h_w$ICf_OaV;AAF zJG(WH6SHaN&K2N;Zk9G1C>zaVZ4k@HQXW%@-*iSal?o*aRst>=b*^VufAAbgTHTyZ z|43GWltN8iEDc74v^`TYCfQ%!!9|`*UlSCM*p37)8RLC8~u8ZW)tyOy25~-fc z&>GEeb#GcPh7hU0$s?8F4M+$jBeF=3I_MVJP485=)3EGKqI>W(Of6Jrl&n-m8% zSmztDM1dAS-njtAcvAcTWvdf1KgGtc7;`vZk^ZWB>M%7H8fkMTZ*rguW6eY2$AOt2 z`yAR{-Z+R5@PU|S?-9(TOb53VcR^xH`TGw28!=uazh$t*Ko3y0sXOv$m@gbuaqnoM zt8Zb(PMc-Z+60bW;bsT<@IP=LfU;Xx=f-cWmrG%jn^^V-UtMrHE;s#%;Qi^sTukuu zgUd>GQwqe}ZEp5j?uq&~^UQv_?45x;iSWrQd44K|-&Hf3N`M;$ejx6GfK$1v8OfuD z7HM0y#l={BNKv>6G)R$;J}CtH62IgcqSe_2Bxj{y2Jpm~X?T4<)dQ)rn7m$jS})$F zpBKck$Zx+eCLln<$1lG`j2W<-Vx4AJ8EI$f3=2edkCd0CZ1x1MD2HDncMc=R5|7|1 z0$!lv3Qf{PNnbC1L+L}a6dlq@fN542yFV0B#l#SrJKL754*6mvLY`VvP~{84%TH_F z|CF0ZV99L^jG5X)2Blts3byTb$d>{z;BQ@BgrlmJWpU}=jQg(;GD{t!D07WQpnqNu z3g34dQ=?W24eKf$?-aduoyhXIx+pBn2Vbiwr^zNis;@y4NvDMk9Ldxy02>=(S-40V zucj&3Hhp^lJ2T|>mlcT{13uJ}(@5DY_*0^#I4m?i*+HU0jnzGcyiofM?pGn6XfN4z z3%H@AJvO8u^A%I~B7Kc9t7+<&^QeW(UyJpe{3Rmc6ay-z; zkrf!ptf*zQB0%e$5*n{D^})wq2nCrG25o7H6DfLJXC-f+ zyAikG%=U*eif5y)lJ~ZWFolV@(<@lIJpujntG zuCul6@{f=E+fW1rJ)hO|^1s${Zwn?Xn{m71JlLwV=`3--u2BHX1VOgv;;jE7y!mb( zp>#v;vE-Vfv2}p5^N_gO_+Usv=cC}VCk7?cI3Go3+i~eI&mJ)sGnC;Wc~#ovDp-DL zKVSmZ<#Yr#lwnpXQ_eS+7$dE2rH{`MgM^cxhDvyTYzB0oE~JGf#EQZa#d7 zDpUKhbmS4;C=nWb1d@%)rYT(7sstLoQHaz@GSk*|84cZd(7Lq@H&5jGXn0{LyAP}i z{t=J#R|u~*|IKbzx8lX#Ic(%<36Sj&aWN0wdt;r%?Tt2Hvr>5ZvasWpT1kncXEmflQz)W|XO23#bO=jurWlriu*H@3>9En(O4O zzQD_G@r(~FbAPQ=GKZ^oY}LsvtZS&IweVpfpNITByaK12apzw%cg&u|3G|K;Or`eM zASjBWqN31RD`)V^TA^kag!11Fd;9o^u2sLonJ*}S0oE)<-f?hiwOaR4QjVPfrt273h&GJ^3P zc~df}kCSiDBi|(7JF(?#5|U$)Rj!;k#knHTxBI1(?dKX}S)T-hZ}6{t zPIuTs*rLEdV5z+2JhYGNggSmdjOx8mG(_s2@9B``#gMc7x5NiH>J|hE1)xRBraHHg zn);F%9Kqckm_5KU9_b}_!u_*h)_f86#_{?2kCg3 z5^q_Jhf_W-cE?duX~Fw_di9JA%NY-JvzB>3{s3k3gSwa2C^dKtUs!GOOs6bUtYaZj zM&;{1!U9hBM|E%7`brwJi}eFsyqBT4&p{1ui=9rf`Mt|GbGK0$tbAi|d@^nv7Y(#1 zsSPFH`f=8%J){hf-y)(u;k^5XBXH$UIUQ8MBv}*cYZByO50}-Zn5fXOF@wHAsskz2 zZzTDn1*E6N=(~&7FZ6hNo$Mh+A;sJjV%n-SCC3R|vbF=wv_8=cCWpR|N*u3_qt2#Z z%M*(q=-?G(BeXm8fnCldzdCa`UkqyN;&|?6Zu5a7S?ND3{wfUVgQojF$tfljv|EBF znZ2o$@5;~p7HJF71-9B`dta(r9(mb{mScCue-8!|@CsOf66eYVoHXQvX53?zljDos z<89wMH4$#-BUclVu_bnj2xq)}x_HCs;B&+v3cQd_Qi0873b=5AIeeGvn0i2`^DA3Yee~w_Ctk97~AbLez>dlT7)4 z=&iir(_Dq)Yg>AUB?{Hmo%`iUNR9ev&F};VUB%wl)GR!M;~iMDS4bFJx`t>oW8&eHC_7KyVMu@_%wb!?CC=ZEEk@7(}C(Nk*2@ySe)wP4k=9iDOT z|C>Vowv=o=cLzr5?S$E3W+@C%;VlKw&}2}sQ|tbq@>c?6%_X9Io37WAq9gwpncgVe zQB62VJy3_9f?*HlgOZK#K5y4r(Z(n9moSd&ITH)H7M!rbRy+x%+Iqf-ywm|N$hoIf z8|OAz3X>0Kn*L4R^B3CwS;c zVa1MZw6(1r`>`2xw91=>cd~frgzf##whIHT_KOVJu|Gx9&*vE7cqLiN?l^!lq&mrj ze%#l0Dm#N@D&wrpLB^K9ZnABmyEc1?+HJ77w`~pvVW^=yCl;%%2z{)FKb{*UWmpfx zO^hEzVV6vuj9@}H<3PFjh|0m=D6PaZN5rKu<$G3yAOrz#!&p%|YH*diF2bZMFeylK z=hS$?&q(VqDhAJ~s<^6Yu(B`w2{3P~CRaH-2Ny^86tpF0DP~Wv1yf6HG|+VI=mWwT zE>wPJv5P&-TXSPtP{h79^I+81BBhYF`rwVZ7~Jcb4aj+9ed+6y;eQa&@r*TFj;^kJ z=sUn8mXm!R;>((>XH+M2(QD<^h#A6A3eF+Y{0Pg&5U|CaVomLs2b0fctHAC&K*WCE z_bS7~LJ64!FnG8;FVe;2g*Pt{s@X^B#$1 z{=Q2`_{DQsGkb%Uv$~SZLW-oOqP?=WH0W$kK-TI=?uwA@My=KNMbcvMfFS>qwBET! zG+KR8>^@H@XL%$sNggok`b#z7k9^$%hO04T7K!&Aa3{wvunn5cG0cuXj%c7IJ zQsydUXtayO%Yx7WL>!QK;v{41Qg9=Ac`={|`ib>RHUy7|`rfmFoosA*j=w1qK;inN8=8-Lte@ws)i zt2L-|sL#_YYp~ufA;+5Sft+%`ZOq_oU5(n_3lY{|jXr#x&=(YJLBPq^=szcxX*`KQM zMSkDQo8DRsTyYgh^=Er(ltkxwA*@Bkp~qxLgGee1W(!WS5!kH4@P6V=3P(JH+V%8W zYOLg((u{D-LT^z{bL&l85m(gRBSn3(oL|WyPfn#sxat)BJ9j+1<7HAX9+HqDZ~<(A zktvme74qX`J){dPtsZWizj{8g2?MsOOY7{bNEF@t;Eka_ApMI@;1YUf83(Oc85J$> z70s$68b{u|L$zx7lZO-U2AU(k>Em-NKh0*FJGyRtLEi}b<3L{D*j6TqiB$^Z^zz3r zkzG|L$sm*fhI%*`g{f>?J)*eED_R5H+JI8#QEA~9!*1yy4vyn*@3W$I>?_An5ih56 z-B;mGut#&cK#65WO^A&yQR1KG0DJY-mI;OqpjrN-28weI0kS`aQZ%e_+8+$iQ5X6X zce_y$nv`bE7Ly;xsi#KX!l&nL^4dx}Mjq5vkkaAcbKg6~L?U6%Qs-g5>I^x{{jO@qv9$E(tCrN*%UjMdQYCm$_bI|+xj zz{2z?ooT1E!9m;s1$u-01-+IYM{#tLwRJkeB|%FC@JCwW zkJRZTp;hYu35$M}yF8jxj#2=kIDtJ*Uf@3p)W|(sk2^tq1W}TC3 z2e!w}DE!GT+tOKe;)wTTql0ZdV)ik1l%}N&BExTnCkP+XydwS`1t-+wa8I^dLH6jg zIwpP;G^$ZV*(k?DizNw@!ePid_9nghUCtmCu8+U@H=8sH%Cn-H8+zz=z{RV^drto5 zPnhFumDX&~hvxldU>tXrfFEms!6?M5q+dVsfIR>YPtt5+n8mSgh5GAyNE~CTaQ5$rZ00!GDyfJmT%y-Kx?=n5sw9*A9;Pd`#VxmwX@mB`Rjy4CkTewKql1X^ zu2G-rim!E_P7I2pJxw5g1-NeWxjBO6cOkkT&D@}9$C`*?lIfv@-^?OWz|!Qthcrm>tz+%$@0Qnn2*(Cb){_ zcZ+W!U)#AaG9;q%*1htt6fN!VHa_aH=~S_py`F$L34;kFv`faKay&G{axxQWwA|cF z0oYE5PUMAErnVUBDuKfm0oD~15Jk|oeV|`z>w`T0AFa!`F-mCKuHrv;oi@CxzUNAR zw;(0AOE6MxW{<@r)RCdTrmm$5H!^@f3(t*UqT-?9#x!>WtznS-)DB;QM+nJ? z<^{St*2Mc)6BBVes{2$}jGjWyBCS?0F;;45m+IXvh zJ9wN??AGKTQPB(x2Dbi`a#w_QL}0*fi)&FjjJJMtx%cZ0x4V*x<#Fc{_3_!K0?d#z zuFYmy-H~r&DbQ}?pq(-CCm@>jcHmQ#yfbs(L1U{actNKPl7@nVF$4T)9VVTjdV1)ijQyay^9$9dAzPgk!)E!7WDTgn%5J z8noYHo6CsOJAwx9e-+4F1An(#Kv_9L`S^Xy*6&-h(UD!Ln;Mtw_^)?M@XnPaL}(>( z6dvf^Z2ZUmXL~cFphZMNVGkI>Bf`P<2Kv;2jnQ80n9~5%g(qX8f03TNsaR&oMroY4 z4Fhg^JTR)FqwKr?S~!)^GzNvMOXQK`_1D)$WR!$CBC#|QEBOa_i0Gy)U zu3X@BIz~!68#$VLmzCv!GWi9`HoNHr4h=O3uWzdxq>{R;BKm z*SC-F$IWnMOuHCIv~ytl<6y$X`Uk4!-fTGV?;#Idg7u!h^DK6MhH;2 z@qML%Ue!&QWbJCjKMcPuGsH>gcnLpK3QOf{&3eSEy2m= zlVawLymzqe?wlv;NFN??CZQA$ykgxct?Er!uP+9n+gla);kq2Udc?u94!YP`6HmcA zNQPh=9gkh3Ntp4Ty*QMrDuD0Yd3a_NEx`Mm9rthvW zkaHr8T)@8Kfdp}J2~3phnkdsn>c~U1O=hE>xe}G3`;pWqV0OKE5CPGvk_+9ja^|^i zn34|cE>!K}2J(cH9^wvno5eTlTF>@~?RS(R?AI{1KG0;_uWT@^>P5lOxin_+%jbQ~ zov(=7XHO<=3Y4unZsX)si}^FCz*<*a1#Rz~=e_xC@Aw!`mtsOqkd=ibkrCtuFQ`OI z>4u}K6M#KbLerb5bFI^)T}s3M?STSio=ay_$^ukaJ}maZvbOhKXi&N1|6Gr{_4b#}0poD!8>l`Wq0EJ*dZ(sg6TR?dWtJVD*8jqe;^Ru-Z(c|fxstft;fHJ_f;Af@mP}^ zEFp=a76AsEXwpzK^#~1qfQIhx2Ty5&8~?JWvpl}y4YVVxc_H4=E5!^o(}Yg9zz;}% z9VenBir4!J?VBYrW?zq`)AWKcA`fTPG)$Y4L$J5Hr70Cshcv703|@$zeW4=-{C=Bs`ki`i!ggew$0k92xqiW zvo)qqo~OP0I7++E5Io3y#)uTW1^@W6RG&slLSeG@`etTl6p}HaS1bZ^!1_TOE8u<) zY7IJmDrJ5QULbi6krMy+Iy`)Yf>})KVx2<;`Iyt)m;iA_V>0zXSnSbMpdw>|y?6V?{6N{O8? zndoEw_lPYI!4ZEIc4@&TSQc3Mw1VrNL0Z0sc0#38vw3?3WML0BiwcJ`eO5>*np*v!6nwZSq`v>2Y~&h?z}eAtitj1WL1GN&4o=Yyad&BVfb2!qzY1UD-8{Y;mDLppnG1mz?2>qn+}dKMY+N#} zn~#)(`|plb{Gl};jyIcY!F%hmTg3l)ab&@G*IF;|r9xG`Gl=tggrKs>Tk*bLifm}B8nn{T=^Nh-7LKPkU0Y)6*aKA(4bs!E8NIR0`o-{R zvS<1X9-i%zF#Gp_6yedbJkDU_iD{1dZngjL|I9iVE`9%u2<*yvUs+?wgZ zsYogdvI7&)9r#-ulUapW4M{ZCbL`r}+wNHHGDlcM073$~hj^ZR1&a%sbWuq15u?5< zU5(aHDBt05zLN^01AO;DblYz}*8Gx?pu`0-YC#i%iymn-@p9V)@A-~Zp@b9I_UFO7 zA?uG1g&Fuu`)c(Td#mo7v*vdzJIv5RkOt-vOk9q&xt0&}o*V&k}gkkWi zy*n7Jt7#`@Z?ofez0(v3Vz#}xPao~?h*|dy5~pmJeJbfm@WtHShwO!>azL@=%O*kV zrc5#D54(feFLnms4bNy+aDh6;AiOc)$eC`sX;>;Sjg1HfBna#PX9)*}6j=)AEi%z5 zVya;lR>e4=&=tOqFJ>S%g|y5d>!J0(H_P6#40OjYIZnq7YGP@@osShl%3Le$jkDp^ zdWSh{%NvOm`@f-(_YmLuZ{FPSG|UBl2~R6sE=_|*Edg)mb(Z2QUCY{Jg3oklOWh2HFf-BjG(1C`{5v}k=?s=ic7p8`yZsBG z(n}jw!C!-_jK8!6eg#gUu;xrh6kBdQ;OPI&btyHrm4`-#b z)RL7>5>Ml1z>Vkd=x)MeiH2sHXJ7M<)C3qk^*1J{H!megB4+jf049~qWkpbwtyBnU zSrmb7ph3}{r70z{D)Bs7&6hVpiiMJWk#)HqDK&{jp02y2wuGAPb8b6tR)?I{S%Ov? zYR7!3Q_IH{KmJhW6cXF%V69OL&g_;*1Tf-9tyFGLpIXu6pZw-0&!KGC1B_8_6djnj zjvv_4AJz}Y1^ltK^^Kozex>$UMBz9x@(eL&m0R_}_0>S#a3)bW^EqPQ?ME&;Bj{(BIw0xmxHTdR#h zW+t)+ecjVS%u}-_U;AjL61~r$YQRn(*AVF_KNi-Ai1*lwOIG~IVfqmzbZ~< z2j|H&WE_D36)FPVlRU!sWu)37&QtPtYGQM90df_3cD4|0YJhXm6_s9yf@}A?^y6$Fej1K&Rfr!$GQoFL*O|AxLJtlEqS|k6tYot|!DUM~(UMG6h1=y$d2B`gz)X zBBgb3O4wgYlk1SiXjFsZe$P^1GWSYBz9;dd!R9@(wQFe3CBOqvm{is5@KssiZPIgH z-Vcd$r_mRroGO`gQ5L+*1WF zU`o&Ro?pgtnU3(!aDbIumlQy+(jl>DkCgqn={&OzMc$d@mPP3;8TzVm%zojs@#7D7 zjV|KUB#lRp=VjtcrmfUSTaF41p`O2EV%LF4|K9xVh= z(H|!X5KsbUSyXRTh_8kl|JiqTc#H?i4|o@cnwm3*kX%k4>w^T*J?U}y@rtYc4ZQPb zwfL}M$-z$14AD|AtR~tzlP#nQK6X@^wK^{DmWP90976568X_4G-&-cohF7@kVHn+nRJB9!N%UFmB~X;G2WwzJ#cEMDtligI;X z*h`Y%CAJ00?%awfR(f_y*WEQ!2ekf?FkA4))k(^)U08WFM&>YQIOQ5%Y^JBk z7LX|m;rARq1Qj7TK-$jqLst6_jDJ>nkswln4BB@*S}9@^lewVV*kw7is;oxiu`k}h zZ>NE#-8hpoY26Dwgm}!M!QM`M96vpkUUvEUyuqv0($8Y7h|4P`negB5mB^Zj7wmYA zS#d1CB9#e}5Kc#;)^p=+T}u)GM|beP32@6SYu(XGGn|#QRNg7^>)?V%6_P%8Sq^KD zCr8r6`A@z8mm02ymOOO=DfcL`%9CR!HpwLQ;=KVpKEB8ypHXQuqcHykkfs+WxAjv) zQ5zMeRr89ldhD+uk_k$V}xSv9uMn@qq+!9^^8Mj1KJVGg_H}R$SdOQabEI(>4>uU3Tlra z3e&@t+72E(bH8#iozZlzDp7Qw%aqbY=c4TDz6?{!a1cjPd{5&8IP?Ajg0P(v<9ts7 z()OQuS*+}dNQSkgBS zSGuEi4$A=r#Ha=eTsCOXf*Ba&psppbEJS1xwS%7DObNJ?aR`Tqrt7nB_vRY~kUCyJAoJ zEBtH?R@FM+?1gkQx#=1>WUj;&kKOX6&SDaa$K+ajtPY+>9w5stq74HpS5$aI7SxE2 zrV4r9-3wUoy4l0Z(T~T#r;4Qh`RzfZpLsE)m^-+$;>6N=GByJCXQ6qFBA*dnFBBlh zIqvw+W@$ty>o3OtM}hmczrr=Fix;xzTcNSGQhgI&1^Zj#Z|U$2q00vQkwXaLL&#=S z>8SpEZw=L2-ygijprbXKU^kv2K1RRADi&ed@XY%`97^afhisPJF^r)eY<%Rgx~ALY zHijj61787=j8c1f7oeBR4Ay|CfOT_7E)w^3h}-+VtZH?ZQ=a`ex-+WN&rn{rBS;1C zc|%}Goky0^kEt%&tlrq*&nAfAeIkk?G-@e0}DH%f7ZJ?cq?%{+aHj!oJ< zAEzW~a&n##A+vbI6;OK`{;l!@ScsxKs}gUY#X7+7&u{scCY+&Gj-~r6J5b)R_{t%i zM8*!9Z=?XdP=k`x702^fLtoM~%=)XK5wZ7U`-zpd@t;OWNmG`9E^cW9cS3o5oL}Gq z3b!lQTj_^u%&ALjnHuZt;uO3eoc?L_*-rQ7TtDEEcmrG0OH_(YWb-bhyo6y9G!O3< zmtF9S$)LBp(2u#1HNv2d)OmGZl+g-dqYeDo3V5;H%rEp2XbWl?!t7Nr)8P0sg%hnt zz3Bfn`tvH5>>?gz57RN+D@7nh)Uo2ZYQ^rmw6F!xpD2QF91*xfguc^GAB<0UORABs zpAQRI`12HDEzp@SqGq6bsN)?7l35qB6`6=^Vr>2KCtVOo0P;qb2Tc+%spys*FLE&n zNWWcrJ9AL`dmbC-c1lP&+l=KX%ZCND zMUZs+w_pKw@CV_h(i!B6wR46dDGn$9mE*!Wg>m=N7O*vAvIF6c z%*$htnWR(ydxsyRqieKqFuzhHa}{ZF0#VzJ%$g7y!8B$PozITx zEi8`jVAq)i?MGO6!k;P`lb>i<5yS?hjnVP6!GLc)Jd!G*8$5TkL6QPO5zSZ`VA!8V zCc%b@)n1Hw&#o-%`(aT$=)h1vIiN8*c3Go7CGKQkMAB`;k|m9xANQN|W}vA!JXt%G z3YC`wJm|Dlh3TMxy@Yb3HKS8bqD%n*Z%I%g=1*KyD|FE)D(!SaRWBf8lQnOIb{#*V zzyG;kZO)2LM~B)0xG)6AfEjS{@`*_79P{H5eu@8!b{z%JqLfF-l3%OJ{f({}3#c#e zBkXRmT6Tpsf!FQMRnCZe3mv`f>ZUlo+p}<=bx&WL7*AQhL|N=MY!m#130+&eBpMyn zU%8aY>fjImi$cIPTkO5VqZ5Ecg6_j;Y*zLW$u&J{QTk>lgdn(L7MUr~nO4C`bCRg9 zOaH{63UUvmfY9vJf^)%%*0UV1E~?<zF4m+LmDWbTWABg}D(j30pgWjFQ(S%oQB zNxoFeKAu$G6nY7X@%^A9JEnu*!|_9_w@F+A^YFxc8V4^6-fW~yyxSZn|46TvQ1iLv z?TBe{K>ux?2aqT{9$C&zFgEXhW%tP4!rLqRUPIf&5#|DKzvTzCRy;ZeT02 zCwvb}S{j2)0Z)~rQOUQceKmR(HP<|J<$#xtVRV_#mmyW$#a0!bn=(V~Ui4K(YmlO7Ws4b0QlNFiVf`uQa7|P!S7C&8l-<-iU*TXNz=Y^C zze8`kI6e{$wTk&v;!+fosewAe-2S6|E``%vkC&9-S0XRre39^o@F$;zAv1oUa)EYD zy4?Sf?4?v5RZL2^OliK%MRKD^=~gMLaRGBepe&)lZ373!%-n%N~FYcR_v>(`GuiXZ}4IV|U!H zEb{vnbheT$Yoi2mx&q9X+E3js8*jdmtN5z<>ah1l95|MHq21m~^M0klNXdfdJD+J> zt=9}R3klysFV%n=*2ZZJLhA#isQJwSaqveg99=MY=^l`T(fwe(#k3|c?zIIa|2TAV zbC_I&QuF@nguSPmh0cdLLa=#>Jr`zsc@veFNpZ@R7md!RoHre6dF1wGg4Em!=bu-TiLbuM-Vcn5Fs*IilaWW%i~6O?%i zAD;~)$JQ20J*ZMt7~-CJ+0-&3MK2rib2kR6_Zbq?uXtngUD_9jPUZFqL(?W*@Y`8B zkd9*ZDutObG(I!-o@=)n-zakM_H%AagezT?m><~Suu5|xpJMG%r~QyLr6PQ$$?hBe zqkO6)`8RNWABQU0s^Z+HYf7!hA4t_j?KhsNiPkz%ct{G4nBsPHag5H#t{Lf!u3eqaHxzsspy)S|O`=N$fx zj!#Af`f~u1aC%4Bk(Cf_4UUAhT}K1)_f7si80yd(JAT64;*SldoC9&GE!y}_{zJcD zOoWRoalzZHI2dMLh=P-hN`oGI2g{o42j82J!y|n%?VA&%25RnOwCnq(h3>zIxDOYL z2U(TGuxY(mw7c7!W3(xpEg3892pDbZ(d0k=06H+{zPI*a<0fw$X*H-$q_Vgk<;!U; zoaq#~1gMBW>wMCIIHa~T>zkqwv01gDNeDA; zs_C0P)sFNQ3YKtL@WNUhX|1q8r2D}Bl*KnNqml?@OG*T`Hy4}i23gXm{v_#m}h(N1wsNrcY4?Qcayk>p*j zW)_nWknC!VzHn?NSM^)rB(-yOm&SKj{qIVb>x2#z5S+Zx52a`}Dpki8nU^DCb68l` zj<6Q+YbP%}I{h+Fyqs=-ett{QylW>SeH=u>h)bc>FpFW6s z3F8-U(vg-sSwIu_Dk-wlxZ^SU8&J(igfO!zrtZ!_q#k9`Mj|H*^W&>^tA?Oxbb}7+ zJ={&Vy|>Eq4*QfFcvzG<8j*j7cVtea3bJ@~*bd(NZfh>OxL?&Gg@#j9E8F&f`n}bs z0-<1y)n{k{MpG|rixu9ThOA?RaJ{r53O$x@#Kt$8pjsg8ZhcFn3t;4c84B?pVa-sh>sJX3d66Dt(6x4?1v~N z((U!q%<4Gx4t&vU#<(~$RNNs=^*AsNvxv@X+0fhzXerEKN-=RggsV*vC=yZ)c91@` zE)m>jk<4Juc!t|YhG@H|RAnJ;cGcq-N8m?hO|%GX zIYn>cwt$Np*tRMD{2BL>XmPmI#Fq7z*%>CGPn7-(dP$n)52f)sar!J2FIlbg`3cI# zUU|RxWCvpB2^mi6&?S~T$7vAO)DLZ!6eCAJ))+${1v43?pEHLl%mf>oXP`TKM(16)HrJjEU* zpbUSP{|mtp@jijeB6m09=#|qYnffy8=GbgkhE)YO+=}m0WD{Q2r@{v=6c%vfbTcGC zQ(osaDWi!`103aEjD!eGA80d|;Lh>0Ik6rIZ3uYVQF<`qDqY#u!6h-hJ#ki&J-;jk z*tu{3oH5y}UP)fd@&8lO>^jzto!i=I7QztS1|p6Lcif|5nN$wk$dg7r;82h%E z&+^(2WB&kXSW$k$Vt9`PSK05|eg`^EZq3wzWQ60Uz`Q=2oDV?t;nQblnB@r6rNpxj z`899ty90^wH-@aqf3Es}YDrHG6f(;k1m&46PvRWxO)dK}zEvtq_A_&NO#v*iNZj!{ z0Utq-il%C9sEz)`{kFHJx!W7LvW?UAR^Av77Zx6x)yLteNpGJb8G z#q0VUqA7CMd=uPwW4#JUxt$126qIc>93YJ(OeikgRXK*nSst+^YwyvXf~pg~h3QCd z{S|*H02BjO!;l@!sDlRa?Kq>uI+ZcKk=!ipL$z=3kbK3<+N!vXrZ)IiJsC*DqjJQj z=zPR4Q>txaZk3F+Rbql4hNnJV4&WYW>*`YE%hv&Ax4j_@Fb6$$APT^Od1W|W%7v`l zT7GeC5(`B%SoItvnkQ|%RjH?1&dR8IbMdXQLo+G9?z3Xue`sAkU|_ES_>la=qBPhk zrzL2h|ZS zX#CC9m~}nDi0yyB6G!ci37%Lc+v{3FLYF(Lucog#QNmNPw~GoKo$p~wXtm?)XyjS($)QfigTLT#ih6js~iwffnUJNGf-Wb`;F))d) zu~{;2OPzX9Y#PI_Q|vM&sf7r**m&@3)}G9BqbX>|&13+UKCQCHo#&Hg^Y(p+U<4BI zidW*;w{K>5XD-PHJAi8&)~N2GXKxX0MpR!8IACCcX4MQUqZ`8`8B8Vr%ajh9hI1@Q zU(mT1W-KkNtz|B!3EwU_HTt)B$6IMh zVf7m8H^Bf2k%$5*HYVJ?jbYtcrF|*&=up&Ah0}>dJj68LSD5{EJlF291%;+I8omBJ z;O0>F(DTedX+TA3qU!e2*$^d?69?S9ynp`=skgnyM7TMjbDrcgx@Cx@evaxV1@nww)J-QpjAkwn~@K@Ic;%{^B)<@JRVF$oN~Xpcvi*yeMm%;|)+PHmMKfGIB$~ z3BAtTU)YlYio@7sHKzL)#h19|U4mH8v9@hcQ#w3f+m>#$!{E zHZHoXh}sgTw{ukKDe!qwkX{urJ#vz^%SmBhhd~FaPAmc<+yz<7FQ#q`gWmi+n%|hI zxoh128BxaoXx08ORgy+HUS9Ys{0a%hMR@#u}w4$6LZ zQX^$x)}ei&EJhsWP2w_~gb|LaYs-tnS~@G!*D8(0!u6_Iv*+>;+~(piq4|=Q!o~K9 z6X~IL#W=y`b-^*P;620IDTG3`f9EnH+TZt=8LPtyG2tg~TkRSU!lqkLgxvm#VXYj7 zl9T!*wc+sBCKd(7_nA7ICIYXqs<6@KCY@$^Ze+gz;(BReLhZp+hJ#!aubuoXB0=5V zW0=sC7c&*jpog2;3CMZG;GF7yS{z;o1FqMFefU70bLwyvoja!O%RLghdP^g z{!9BaUUO#|9SEx3MU3{?(Ne`o4<&w93{PTUq=ayu!^finiL9%)AKvVylDUP3CubjB z7q*VUHR`EVAGDqRLW|vB>7lzPn zZDev{n$n8*-nDa?PE_e^RFw)yMXB@h!=-i*W+bJYCfri&k^SBo5y1_+;BSWI;f4s- zfQh|wp6ByV^8j>V3;MAFu63PMNKWdL)E2Kbksg_TTWfXqoCzi}2uPfp7Wj|kt<%H~ zxzZZ2IXxkap3R6cPS%Q7z3T#BOcR8qX@2<9iF1?|-22$x0%xJcH$Xx>pbk<&B!ha{ z)~({I_+VR&ykEGPUB$Hsi^2NR+Ym$0tcD8gzOqph>geEJl|!TQR+8c76CvQ#KUNnh z(aSxB@ThCDU@fG4|QvFzX$L-z+nP(u1*K+RHg-JV5O~x&=!BJWMbm!YV~3 z(NL)sr6DJAsEP_s9vHdO7a-JBKE$MxD1#RxmU{$weLtL3Q$=7Jx}DVWZ{*9Eg?mc) zcYsBBx8ay;ukF=8D@&Bcq5ey?%@60=p2Q4x+sIyRYkR=OC_{c54SaaxImAvSb@p(o?3|Qd5 zx~wXd=>NmsCk-~7rZ8YMKiU+_7z<@5?kApI-WaAI1ER>zDuBo4GTyQ3Rg01NPrmf* zK0O*sfZc^|xu8d77^`*vOZMgxL_Wyde-9^`bP(0gqDG}Fn3|;Kv0MBv0C=nX0{vkE zS_VRKypzbNcmK>i@`0$v*Q6ftZt364bM_xce#lXpWTPKRIvVX+7*YXmNAi_)w_FZJ zaH=52DjuvlnLpwtvEc?o95?H9yq6IyWPaekde^=R8#MZQ2QTRpn_l7KlyC~9J$iLx zgQW&Anl~OO-I^sWg_?4fsO=ZF;syB{o9`Vm$brp%SNDqmU7P*TsYO@56~jC+4W`)@ zL6khVGxw{LZ!C994-b`oIOA)B-DUX*xhtvIgj7F#%5?B+vet4jymzQ1wHhgBK8gdl z5aEIm_F&VzV2~}LowZeDfI8Ck8npco5+`TF3t^5`k6k9YX&mx8a87q-{s)P_t=0Ok8!drnY zgUR*eUA~FzNkt49S(7&n-86xs^`AhXz`qO0jq%MgqX1fCxN$Ass2_lkDI@#vM%M~7t_kst;o*9hSJlWkt7xR1@ z!?T5({e74)7t@E23&ZY>QYzD2>b&3 zEE+GxQOkXjqyYFJg27d~C3v?Xisb?(J8>$@b!>Fo@=ski>iAys3hGF%~?Tu>F+r=nwwF!Jo?jAWtU=Q?vnSCO$|qthdw*R4D|HYw;qZ_-)U?%;**7P zPu5%7Z4(?4z+#@vS`1O~3DmmXZ%eD^%k0KweH&q2QDFOI?w!USoO7dc!uOH4D|I{s zZb&yPEnQ`ly&^F`-5?>!T+lytJs^3@fY4o1!fXYk8!SNPO*+z8+L$@><}mogsJHDA ziZNI;)jV zse(j{pZ{~W-or4C5MR_lb+8&^oQ# zO1%S3n@X)P{A<#>^h8_U)tWFA^C5NaPTl!p3)X78??mHzi&r2V8hk61sPiaLnKdgJ zhRy1JD^-Af&!+bfVk;?L+c0PyjbPwP`q!p_k9WSB)H+;-HaHx>q6d?6Q?2CXJ-4rE z_V9Luh?qy_Hw-Po*ANwCuGE}U?_-A=r~yn5?q~5bG5?URgjI#HyUC;&-T-h@jPMAxkNXTtcDel`rV zhG$*uW6aa0GhKO;HW`-tIwY_E8|L3Wgn3vMe9*1HTwH6M!>pfN!r(=A!(bb0(45!a@PypRVMPWuY71Iim5%6$Fg`pEHAyJG%=$KgrVdqd1k zAZ(fo4d0et67*_!Q0Xaaao3Qnm8&wQ@Z-f2Gn3drujkbBWRJVvx>Er>F{J905?Je% zbOaS~YD4iRt}M0rJ$DadB)nwIlpf)jc}j4=_Tt=a)_69!fa-rAxI_gG5_?SV!5X(W z0?!mrKyY`r8RFH?T-Jj&pXivYQDse%dY)j_O(SZF2aHwr;lH&=^zXjxvKPxbE{uYI z*uM%?e+fEx8f7;t9b3w7>*qXXYntCVXheVBGhU1y*fNq4Rc2E5K`&UmEEDS<(n0ya zL)!lIZhDbtm?)vB(-Ii}Ta@jP#eo2x^bP1`7SlqVnVugfMHYrdmG+~jLFn4kLPh?C zjtVtW(4f6(Gg`1m6Y?8R>XH7emo-RsAk2PEQlipFByogP**2SMs+NR>_2f2^!ysZDKIO;j+oA5wdX;gPDw zaBY2nE_7tCE`9xXaaa`#LiT#$k;}GEh!UfH#`-}-!(mo-jDYN_JZ086OZVgvlt8^- zADLdSM1x zcKO-=uwcFlYWD&RwG~_%%PfVem3^6cT7tIb4vd5((dBP zj`9)C<eC!cM4^OM$sE{A%q>jFwuAK zq{6Vc&zDgO||r=6-U6AJJGpNrE&AV>WrVewH5+2j06P zUc1eWS1#mxFI&}u>-B=JVzB{c3`jP@J+4J|Ywa1ku>*@H0EQz-_%*X2 z?|`{IPh$jlB7$YXAr_le?UGsA-Ywd)V6eO2HRFK1<=J763pf{E2{8A{W92WeMma2b zKAeImbt$6O*g=34@ah8;8;)d|;UFgZIDlY;5?C3i6LNzf>#SrIDCITA_|S>0{Yj5` z9PKyDpyrKb12VWCgSO*n1ID917t?oDN<6w z^|ql?M6L#Rqb3$~qQB30`Dao~8Hg#dB`|bN?3Glp*sZOXg&*8I`TYpCnGg$qCzNy& zTwio3VZ~GsIj7j{1X<}I0y0MRjQaYZlF1W_66*YF);+>{zea!JuijEw z|EP`78CHgkwc7G}GZn-~r1bnaP2%VVMbY`|B@P{vZ%7_NSRXZ%bj0YbR>(rTUvMWu zYxM;Q^)&T}(tH^EP&)){w0R^Y(=y{FbjaZrVY|ZM!NZ%tM9`ER$-ZD-6#EPCHx)t$&{ zP3|OLGj!u8_OjEN=!ps|JC!kV1hjszKEpBsn82?YUKP=UmMvpq6j?uUsOJD&2UHcy z>QMAq$kL@WX@_U}%nrr*I zofUP>eCPh|(*JuU--8j&`pCGW9C@Q3|N9J!Y-PbN>M6z#jZ=&MUfOpL%_^=6`wYp5 z7?h>tMcJgV;LCrX+{Rpe;X$zRqJpmLymeB^R!TLUQ;WSI$E~WM ziE~>XXHTjFz7lh*zY=#sZdh7P=Q1IR@=;&Mp0l@`z-=~PEXl+RpVdRD)r1hF9YgJY zI5SZqWtE0Bl<+mF2cZ6!-9g2m+iWG3LyPESMvtL}BvpT}wUf?Xt(9fb9J9B_30bF! zpNQAvkrDi8-OaD0aarF2Ik#U^LVUOl`z-SYu1~(|?}i{tYw(IcsFH>wHa1eQCPBEt zXb~8faKQ&wK6OOIVsy@2ND|7tuH*vQ1brWS~KI6X%t^5A%qJX;_G!~ zVp=CW$}flT1~zzkbl+jyy5uVCROdo|4K#r!`T`FYDD2B17u%nXluRD^iCqfmOZE~2 zpbg{8ssH6cJXTQQF_+t!fG7j}(YPHcK1yU=8P;#Tr^^|pC}fG7mZ)q}>pOe7btA)g zF-|NDqsxI;BzLwD=q0z3OzqRK$8QQ&q2xCV7L3E^JtD)}*R0ltE7i6MQM#`fAOQ$b zjad`pu2Lt$kJ?%i&~mKhY$@lYu$Sah0=vK8xdQ{1KSol9%%tBdbS+zb=P>3yrxfjB zr`Z)LyTLOVcBppfJJdU!Y%E8#jcG8%oBwlgR9gze;R7s*n>c4GRF)Hq)>vXnSq}vJXB|kJe4(f}k6>3#Wf1q3Tnv=zJU}0~hxNU2NZQUk5TfqBfMs`6joYuP zMISe%G4Jt?ARtSU2Ts0wJ%Vs?c$`pSQUYTY$sE0hA(lbbyRV{*RFf`Wdb~`tk87X8 z%nTQUE%3{hSCzS6+FBh%y5VZ2ezg0@!OiQW;uSbO?O(LWW&R5p5)E| zI=IfGp!M4SCkTew$pJb4(juNP_nK8sV3=IeHVvffRUU%x1iWIoK1t$2Zsu?aDK%Jf zxkhB;i0x+Bt`@cf4<;YoeAJo4dR*Qw4$M*F1!B~%(d*++i7gN}^dyJIqm}p`vlu{U zB+bM4dXJ`?t&&eUIFv6hOgk}paIUlO);3P#uBiurdH$P_V^J*Ff^^I_R=Z8TOr4bp zNao<2h>gnm#H-aV!@;pGi?TCG8rw*70;A-&~eW#JVcAVVB0N9Nb2 zHwYK???l8}Gw1&F)j`>l26*?WsFwXLX`T%!vPoC~} zqz-~O)l_5JLk-e9vj;7kJo#UR68llMoM~U$o=tQl zcOYB#v~K{n(?~QrR)~`#2CrkwjOhfn^}3`e{7uTioC0@ZqyblJz#kpQl9%R5C8*+m zE%qAO1l}EyCh2k!TzVEM@}E+af{o7ARDh3g)N0D>DEmx1*L7?rWA1O zWwYtB1XuksR$t~cRlfdE4I8?7O_v`b?R<3}djw+!7l3oTXyX09gf1vEl|E?f22KQs zsFGWLEpiv1%v`)>%1W2^OKgt=I+ebr*AK}ad%!)RMBFnRm`9TXwXTPmB#5aL!wh9`<=tJDat;R0o-t9$hgjALy4#x9Yuv{2dVCQ&| za?#?zJ|@>?_8Pv@jd2nPaO7PF4wsNTd@;o_JZ#Jf@S8w2>u+><-uRj(IoF;KT@aHB z*(#R4AEW1CG-dQ;)+Z+r-0JYRBHaCpN6CpDCDgYB74Etr@)ZiT0Y6XbgfR5#9)S^Gg(tzm z$vQQx8Kk}`CDFVh28x{bslIhu5^>n*vvIz|NfKO`_B_ltl(PB9eVx#F z1lu*!i04q z)*O1Hg{q2kf^;HMinA&MX+bG5-4$C&zXoUkJx7st%-#Grv{1_MCLN}=FLlt^0!7Cq z9GXSKconGK;B9vaSQc#evJAmD!;V`h8`M>(U8!-4?k7FtmU%?hrkILGKZ@CzkYY!~C`Is<4YIs0DGmFKtQ zcu~&C4EN%pkZPmVH^dp)$^o+d=hQ$U;0`}tpHFT~pAm{ZNUCoQ3s>tR zcI`Pgbu!ijT_oROII0H>kS5dB=_DjP-x|po;@F-1KBlGH%n z)*N|_vF%DYZUzA%=51=x8=!3+rU?nUZfKJrrb6}idXSA3Pg zCUQ>GEoWp5pKmqnuP{XkSvmEU3L9&22VZJeH1$PR;}95MK#%7R4CCX*k|2mN> z4i@C3d!RyKND9ORkti!1t%AVn`q<~^%WLj@53sw6eYq6IITWG!O;K9(o*st;WM_muRf zCxfbZTW>Yy8JildtW>HDFlF5+n@_cz&^4haZoPr$KZQgum|`TNd1gvXAyPLAW7?^$ zs;hmvLAT9nZy81h3&zn1{Sgxnp5IaPhsPEC58V6@%r12{p4zW{N>Y{g;dHN!6r#mF zZg`SDi!H+=lVp?{;UgRl3D?%_Wy2?$E?$2b6m$dT;I?tt&B(NVNBi=FAC1xq30yXi z9U6ig{d=l7lg%bYV6Y!7PRbi<_7ZMBWldZ?i<1tQI1ED!Z3-KGu&IhX!|#UeD`!r< z0S`K!nWn!ZZgG!4LzCKUK|-LiIY9}87r(~8kOp{^uHDwl>g>DB9~P&MnZp%Tf%M^{W|Q)J(kM>{@RxE<0pKfk(pEauPw}v3k(YLZ?EVD~ zR=vn!BYwk2Oni8*ZPE%+qWZ9vY>zgNl$Gl*NILYmj!DiGQw*?I4zeG3(B<$pE{gOK zltk(`IbHpP?utCv4Lh-SCLa2v?l$wK#iizqq-av6+HJ(`XXr*Crp7F5um*FPYt9?i za1~-z@S(E1^s;$8=jD07;++wXp&%#qS(F);bv{beXe-f^J)c0SEzRi9vL=Pej%?CWxs+5PbnbEbO3E0NPLsE^|jE!1m$O= zW7g!5PQh#ROYh0n7AoHj52r;q~yxJU1UddcCpuxbaL>rWD@J%d@( zNq!sTi{UssS7VE^4LWRRC(QV^Xx$l^Q>7X1D9;-SluD4odfNQ!nvCVVL# z2c+D-0!~FpfvBD9iY=U5sZw|EaG+9RGyhQ$`)M~TE#H(&y5+xgRB9yxp_ZW=^)XRx z-zQ3^p3+6MXg>yN?ujoMNfQng-ST(}Fc187D`?V#QX^LnwUs~${2us~U}X*c+C%FD zMnS%6>u)v@sDvudR3FI;`->hr?W>2i_5cR)uK5|TlXD(3haK~#mZ=cCT78IRK32n> zHEL*K%Ts+Ng?^{~j9+E|=K_R>2pooGXR`KPiv$=D-SP&Er!TIIbG?iv!w^}Nd zCt`tjHsnLyXTm37H7wT72VR*CX%}!|vQ&$1tYUooJs}04glQMl!H0%DuqD&1RF8o~ zUqAmH+d|w+9Y(xy4T;;7t*v@Q%=mF{Jiy!i2~k6f`4!$7KgQw0rP_aK$#vE(mE z22}d+U=I!+;S6$G9);3tn9${%_irPmri>HW(u3cbstdkB;Q{dm=veK0=r!+DSFPuR zacrzgGBUMo(b=d=*;|~3xt-Q+@EfPTpo%}POxt9?uAJScGXwKP!x|#jk0X1EJ3KKhGY|4q9L$-2lMd1A*F-3dJgh zmFoER7lnWM+(ZNqaW{@;0%ty2Gg)=L(AU};!c!{M6BFMbo2nx^42Joe{(*LNfgzCT zunP%QIq!L>_c*=)AU^6z!U=2$STFaxbNkzMKxt#6+~OIMx0m#Jwihav{V*&Ot3PgN zVRE18%jgbTfqte^)h!tfQ*};k7S9AD0?JVAoAn-MFJC?N3yXy&Ifm0IK_{7PUvo)3 zDT+whHMZxGwxP%RZ6UXzk<2(hOnsm&YfdcE)|yyY@octDatI)tx~{MK7E~1cyQFdGv(Qowq;V{A);6_ z@M`Q`Q0&zPz5R2nas!f#qs32OJEA(L!y6f3&)V~2f+FZ@Quy?t*|!(@*+Tn%JpVDU zw+fxQQMojbapHv?ZV1;N0B6osowFF&%7kz46b%BJtL6OYqme{9k1*cpq-OYCyZ-); z3QksPo)*A^D<|;P(As>+-+M5RX(JaYu4vYegiOfcguEK!T=?fBag9Yk3XMAaC+ZMF zld0nFfF#_np>a$sx>G$wYmy^5A-JBFny?oS3U_v`i!ir91CA?|rsFyDts!)`&?f@Q zXKB|7r)sHdEP7a5_2i55Z#m}@-)&9(89T=k$oC|acl&N#s;2AoopEE7HKOJUhgwq6 zEUWjrj{|6cDFA8C95tZO&+uC1)IKxtP4lm}sMX5oQxx*;oPxy(hvLD`$h-x&aFeM; z;8SnL3oD?&je3)CM}sHQP%u+L&uXR5NRTC*k96;Sh7NayDP}wxp$f%%yIPO6?>8#i z^T?H=*8zK!p~a$6@7OmDbzd85;=}wfJ_`C6Z6uImNjKg&R9p_QQz3YO4D5L@%oQ1> zGbw8xsAD5EkpUXE$@xLwgX&1tB5k3?oVR!`K-iX`z8zksPf*Mr6>PN^`oJleQrkR?J36^1w8o;vL&nqxdVCa5DXZH-4sYA;h zPK>|R(!z_K$%+ZP^!mjwmKMO?Uga?c1%cNkL}W0@b2o_C@*bbi3_B3u_PQ?!3`PXx ztP4B_TTq&8Sq$}`N;vkE>&Ni_k|UQBBfnOI;vhr!RbAXiFa>Y>`QzlPLSSNrKSauu zXph`|R@)wGPE;KirV}*tX(#TfmcCW^@4wV5M|eeTQq8FnoSU-xfyPl+juWDV-*&?< zkVVv<9%^ppZ3hB4hRX2YQl`~%@C7*3hT{?HO79DBj@|H>U69$cgzu#$QZ~16^B*Gd z18>gIi-R`lD>`U?$JQNsBn_lnrpn{SZ$}zyquhxzfkm5*_0xqNx62aFR|ehYU2bT5 z!)>QyqSiAxI2L335BysMe9O$%FDY9g6NrYcMm&WioS#)R?95Bg=2vp(?ql$m@Q2Rr z@=-ay9#jgp1Nge(NUHR(xGq^Z)I5~iygQn~RCiDX35cImU_=_t42b{P7wF ztW`@TlZ(unJ(oyBXA|~B*c6;~3rO;=6sybqJu8D%=xQ1Sn4F2{!)V5b+PpLf_J7`1 z^ZpBu!I@>)+?Bpe>khwn>L&5F1L_h^UtM{>?VpU*B0M6@bYf(z&YzL0!1*)5sAC6Z zJ^HcI)1^!WhW<~`^82ZIFWJ4k)MW)KTNzT(Hz0mbZLW-t`Ek=_Mk@3G$Bq;&u3r-Z zv%-zU zyz%IOeu8q;cu^f1gtcNQE0|y+gE~bk-_%B(!{^GAnQ8z{q+V?WHr31>t-TTn1MLXH zl8`5>Hg?KYhlvXSo*Yc^YY*7!rFNT z9$L6BU%WP(OJw6v4OIdQ(c881*8s_A_k%iNzL9;1J>|y;0X^=iNQpt$;hg4+is-z$ zrT6dq9&rkr=&Q)8v{perl}66Rnv$GR*joV~3X0E-|i?lzX0Z!hvDa z!d19QQ>OiVBsaq=VLpfyg`r5LT`CvOA#G*ag`Q71L zar}i6P_)Q<8KoR*M&TF#YU0?u`S@XUhj%PUWS=oJ30Xt$*}lWz>z=1T+adO);u1Z) zFVy8sb(w8fi>K!&jCSdSUry?BnHD_C&$Kshvq4^{d$N9}E0e5hPM3Skc$~ilq@@Ad z4{4*cq6*iWN;)tnUlOh*fCYI67;npcBWH@vi#1q)-q{D{kx@69LD$Ckd%C|o7@ZID>l&KS)GfMhNkgErSaKSxiKJegDl>Pg!Tb!Q!9QKi z`5VR`fZEhlpV;8RG8`f*#lkIRndE3ExJB25u~{U_ z!a+iqGvawuf{GqgI?-orQ*XB%;lui7G>!m_UPRv`6%;NT zdZ4j=**BMSUoDccyjcQNi3{KZNlG8`TI37R_dQn7b8Xo|XUl))qgLz#3oOv;76I%H z=BoNYz1z^o+@Khx((~Q;)QZ&$-Q5Y4v0Q@_`EG(g)Fb2b4dQBfa+R^T9gr{R1};uI zOQE5R{GQy|p+W$ph{FeDKT@u}C}=E_QqWncgw?kvZk3EXb(QMYu!ESud3{E~@< zb3%KnmBVIsdD(If7KSGE6Ns`wZw7dEIDz*Nl?~qeQBIlps$dg#OS*6VOvu9w@vVDp z_ourc6OYbZ2&MW*KN>Tp15x<#phevgEK2cbpAsFM2z8p`iOf`Jc5#3s34-P5^-I;* zI3SJ@$6Y|e5WR;nlwR{|Q-cpT1m2(vq)VX0g~t2Bupxn!@n@r~Xd+>1vtect2RT(D zn*wc4l;qD+h`K-VKDyRqm1|XJ!HtVqVj5uGS4(R`J4JUb3p{54NDA88BX!({OkNy9 z6;$RCzDuM?<>W>0x0b{MD1Gq6(5pNR2r7yflkI^J9_C**X&_w>D1x)!Uie~`2)%+x zyjc-Y&Il8vfU21gbNG*yM5Pq}DEMl6;8! z$i7VT*z{0SccbIuF76E<>_viY@K`;pj}m52&{Oc4GbHL#!-?*bUmc|tj|e46#d@=v z*E-1+#l6r(vTEb<8o&u+zXk<33fkH#s|~%-(MorvL!tL7j$KU8iIsjM%+C)$Mg+>v^6ytWAfdk5&N@!Muj6rASu;xx&Y3?kHeJ-iK^4-t~1Y0gIEP%s^2R?50~_HT&(8 z4&+F)RH?Z6CzCF?(s?Q2lQzuOcAF^#mHh#FRH6|Ln_dt5l?p{gHguge|5`jXX zCikt!l?y3`d#{p&yi9pBH%o^q?5~Fl{k2pZ#U!0#=w{W1k-8z6|5!+6no<{0p@_@a zVY=t4w7>%Qs$@h}574)rQ>^wSh88dK*_&a)0hQY^3$!BY)Bn z6NBu=g^Tq{(F}&8nGq4j6mw&75LXLTzU@?*jM}+^Yta@S+Snzx_r>lQzUA`{}8ov;bA0 zMA^c7K?m?_P@;;i8*_Uob9XLJhH_KS@D268eqqttQtja3jaasu^=xJy6Mvg?LT0g; zjr|y47~;kF_m;Y3!r}16c?6B`(x(+qc5l6zLRbhJol}493FTj?2%*tf6~RG7QxJK< zeW_(Ha`@d%RB=sX*&(jW0CLG)#)66UG55e+5VBy@9kKUDhh5Pp{Frtag#6zknQ#98 z_*^psWt&_AJcf8lA__OYM#sOLkKnMe@1zQ0qEx(ZT)R^_#hvHCgNXG;e-ULwvsbHz zUM806z2t91bPRIt2}JY$@}kx!YcOY@S}=t)7n>Ti{{2-s;OEtxPwXvCF+(!kIg7?q z|6?Tq@IEAm7kwBrX-eEZ4x{>%1`yLE-E9jS$hq292B8~c;-AYAqE-|C*^y>@DLJV$ zYT|JUbFrVQ{ut}l2VW=8RQ3r-hU{n}Md=`wAw6wx1N`!Jgj2{qM+Sn`QlP6zuQB&% z%XT&nAdnNZ9n~K1lro}t(V$J3+hS`|+RzhR@@p^1$HF_OA0^%NWH1PZQDy$5^@;QA zzu2DV<6BCrM!RVUQlv0eiQDz-2UgdJs=m?;#7p-p(fa%DEHzVef~JhZhC@%i$K|%i zVFK2-6T;-ealCaB5RB7dV_%bC>;py%IzH`H^qlZvjOcS(@n>pSukaF}8GCg{dbg_F zerB{OGYTO8DbhVC?J;He+dZIYoc@;RLCal7VDo6Dz1GO6HL^k(40-VImRp5-Ob-I8 z;fVd6ptAA&iWkyi-9?+C=+A!hyd`Y3iZ89(rSBAMmddI?(MfgV0GeVik2`};vfP-8 z=w{Af>Yh8}D@O5!W5ufdM6lzjS*L>iU9|o$nzLX{8Yn*sH$SsgHpKjl_HPKtV@?f} zBjT-SAG}focpkV}aW#QI-xeR2!vj|>V~vW)E_T)Sf0pOO~u=LkUCWM zXbP=G&k;WPs{tx@2Q^gjZXV@rB{v<-zOMxBNFt9$U;2(kpiSVf{_C<+6Vtd60XGmF zKVZp_3imX+~*b&<6Pr ziG}(mNX9#6BBX@{0xgF(@T!lSAp58k9l4~5nQQEwv&H6b*Os9^+YzIs_b<**xrg+q;$B$RzWU&BvSQ#YU1s@ou_5Bvs~e z?IpJK$g~@2os&bP748{c-bn{|m9Shv0Hfzr@izR9=i4_t+3^#8uIdE?v4952;c?Vy zn>)g~Y@(($=fjLaP%D{OtVFRqd661AC2DNUW~=;q{H3ND5^Szlao@%f==_wci?nX; zPbQOSLSQtBGzNi5MZgT{-6Dzf7(o@Pk6dLz>Q%<&`LWm3)(_uE@g{4Xb)e|PoVmQJ z63g?4^MkO(-MSn#DSV%nfm||Zh){)bBI6}|?9dKeFrHu6FQ=m5 z%ss5FI79J}vNkd0OYxN02HZzF;4&~SOMBs_S{mg*1Esmu`yQ-&sQ23n1LS4koz=f% zA5`GmAx6zp2bU*5aO-m(awx07i1)KqcdvBP?ItWny6SQk-W_ahj@L-!HIb4$blHRu zUCTHdKysvxr!8RJ5OY)|0BKoGxqemOZWl!(QTT9{@%|SlyTf70rBhzeiEY3_NAU z{>%aM;kR=0bSSlOg$YQItx*+{U4}tQ6GQTTE$q|8atxm#(i`+*rxT$;XniqDf2V|d z#LY^FVUhMV3n{^O%yMxWN;`f6ki4d>d>LEN;l%oBU$Cx@`%0b4#6nqW68?gkFMjtr z|H*iwq@Dsejh8LzZG`ZPV+`Gy(>rk3JV{CT&)5Qm;pvB#XiLpP(FF#RHyY2RL6w4L z<VnRI_SKmrau^#%Pn>2`_~VXKVPvgG%5&|5=n%4cXTJ=jOj^3m zHZ=<6(v+^cJLht{!@8uVWw^u=19Ozr@)57gT2UX;_v&2!8oNj zEjDU$4kf(gIY$wRY+C1CsC9&5mn;${KeNmsG1a%<*aZ`DLt!Fu>vmr=lPtn#=95+ zc~cV50@-4Y1pps2Js3_Q#vmtwv@FkepY<6{ANX%M9#g~)Bhg(p`4hj6jsq2T+L!u- z<=odB8U7bvR26Dd6?YE4{(beaq!};bJ{w&~7y2?(CnG4|CV^Q4S+PjB1C{|(L(pm3 zQ`m^{kVs@F*st9iL2QlkDz8RF{gEZ`S&fDxNuiY~0#Gawn{LG0n19pZyVm?4o0TWw zZ4wXgT=J(#ems}l5UBT#5wJ&h9@`n4d?G}bd2U}}rSNcXa0EmWOPg-fX!jCk5<0oA z#JG?1W4FScbO)xFu1g*MHuN;SYSnBe3Hhuwh@?x}dvkNn#a-8Sm+_LEF?Nmb9fsb3 zC@$KYwKtEWj{+zSrt_>Rae_jnq8`&sC(n8%p^oxKhT|2$SHfDTEx3&qP1P32o30#G z$HB^}!q1nnPHZO>DKiO|NgBB8VeK-0{}L4SKbs|ye}uRk&n2g^gkR=wY#Eg!pu$!b zU*3Q5j!|KolZi42;AxV&5PYUFzqBGYM!rse)zikSx*#1%XK&HwsJ6dCw!TL=mqpJvHzn!0$@=AO3k^$7ZdC?93i8v_?}rbt&$2y^(StS&8VOSvGzAAYOVx!D|}xx z1PLZ;T4(vV`TLL`r|LeZC)t8DU#~V z9T&Izx_?v$jhNTC(Ue)-d!Sot^Hf!#8rd}fmuC^#WZSg1_>ck)>e zPM3+1ED5K)9SzyST(YP5V`r&Co4zCpBY3HTin{ROth+J7p7=3wWp%!r?5sGqx2v)%vb+l5t|D zzy9{x1mURz)Qw(ETF&oC8({c7EAt(V^^xv`_~g)kH_1sih5brbZ+yA;QmEKI@-J5z z(VWoPJ24T?$ZO^y(W$|ws|LG^$Yt|8H@dO@@r|&?Ks(TN!+AwZn!la%AV;zy-9J`* zACwq0Z2J`xZ2L&5c%eNuwb$I)Z3wM<)CQg8eBa=F%$_0UP2q=&CX_DJH0eWF3K)4x zoM?^tQ(>&YmNYS?^bC=e>>ev;_iJulc#2;Q=b{A@+mrWy-BR%mSj)dGr#;~#>s$|4 z5f0R;nG5beR7seyEyS30ZD5OV_s7iD~ zeA^km=N4(&T-Lbi$e8qn2Uv?{^7-!?A;pYFOMs;rk&3S;JV>Z*^o|Mjt>2fk9i^LC z{PMLGNO{5=EPP8E^4V!IYjDt%S@#$Y#WG|zr}pM}ZEc-Dot2HjHV`)Vv!I8j2n z)p(9S=)R~^BKAsnp+dZE>$J---K{vZZ?7f^tEp9y=!xhmLDM`io9LC!@aSPfEi5`D z33UqkJk?c%34!64Z<>?=o+wLA5f}X7`ZzG1&|AQCg~2o<$s5r~FAvgJ@w8B6D5OFl zfU7)cRR!w#Yd2Zp`S}$`X*HOrOOj6|yi5fk$x}-9x#k_@JZ)m>;p2ge&Dl}tG(OFP zmS6hPRsVWVUlGT5RDQmq)tlm~OnVun8Dm3v*=v;^GFW&RIk$_Ys4fKMHaEOfa zri?g?A%@^wEWd?-GL=xTIwex0l=T%`n+}}z^QxYe|JA|w4YFjl~2}Kegdtt z*CMV9fdzTaNMe__=_r~&`GuReIAw;Dg)D^3+^QU5gg)FRC%%OnGY4bZ>4+Z1d{=jP z83Z}()$oAum2&TVR+1g^hal#`J;kQ@&24<0Ns}_`oMEN=6n~_AX6dk{!VY6n>*XR$ zi{<58PpmpYTtD9b)i{k>FSk@Ms7SLZu5|ct^iRvoD96QfG$% zEJcP24^z;>7)FX$(!tyK!D%#63yRD=j&IWgV0C~`xgQ?Bd3QB zOj@b6IGI6HJ5?NMe3|y#k*B!N#QqYvs528TY02lgc{cqZR6CCi&&2-0{Cpv1U zs=jQk{`+R0@h4y{2l2hjMKwFUS4ot)2GTl%JF|L}{a!Z)bdsU8#*vl^x_E5%t1n55@`{x$=~*BVBOMQ{ z2%QEligY?AVR+E>T_X)uq*+SGMghaG#yS2^T|@i2wmnnH8v2@`&}~iKJRIc_Sr1aV zeO2-DC_P#=ZMp5<8s!gT`WR++41zjdS{M6ZRfmzQP`;)#K1@sr^z52&6c;Jha5HQS zk{Hm6Cb2na(>`Y%p3kiyX<#V@Z6FowkE?i!r{=nuFroaS!844lj($kr)?16z8_)D9 zF$40e*yh*q3^4N0AB8ldl~VVUAd66s377mJL7==exK#AGK26}(YNRMY#vebxKUC;2 z{7OHSU162LhlKdA{9m8Q$NUyk1fx?1%!A)|v+Inbya#`iN5lo>MW<6mmzq~Wc&Vy^ zrI7_ZlQqH~f<{)L85r%n)V^~V+!!Tqs}v0x-pIZZL^lLgActfAM1ig#HAvR`4Ay9Q zM;Q_x`+wc=(wPq?UZCDgE>8eat`9eU27mO0+i9W5PWF>~aW*l#Xm#l<7QPT&>~RAf z#C!g&iJ}GFN1KK?qT0WO_l76IMSCTRk+v70{(AI3D_nki)QQg9naX01#jn&vw;6Q>QZHUsRxV0<0rSf+ zlZv;1W}&(`{9o^;+L`SxHit^ zMSI_=?a~bSahU~VGeRcY<*)@0n17h6A_hDzO5FAjMU8*Y)50B}d`R>M*^;x?6P~hZAd#2+DoffY9=_&=^_JXfB7LS5E&Gzpb7@rUTvI|bY^0uRPYb@ja|Fr?? zgFa2^yPoaO16PkjEzC$2V2`y^tZVVItIlUjx3BRLuc9<2T${T#x?2_Bef~0J<(=>l z^v_?D@j{G%!wZSFD^#SVCsLv<6fUBg8%$8vEoqIfoo-ftAC|N0;v2vHj^Bpe{nMAP zA&litE8Hl-$+J=FYTav~Lrtc@jwNw;6s<+I`&K@r+|_hbr!fu0Lf`2;*H#J4N><*y zU=*2V{nGRkL`U|LrBfbn;dK{(S&qUsSpS$rl3rIw81 zq>m}rxErw)wP(I+YY^UIP5m)MV%0^H9uf3b(EJRS8j{^vN#Rf^;vderiVBKf#b)oTwjFWn=0H>;Qs)14KK(PIk2LqFF~* z98Z{LC5-yC>O5Z&fF?t}!P^m3vfg2DDzki~%(k%w^yLVDUI_TnC$U~J64DRD(F&D`uV2!m%W^4_)j}U9TN^#X>vV_lO z>8LwK4hGl9c-L^AIStafAMX}|uqsqge<8*#sBA@rw`zG=##zU zP4%N}4z^J#_bG@OGt9=dyo99)5o>G%id9z!IlJw7_1CZ?*(-*I!6Vn5Z&XObCj-Pr zZ*)n|>BZhenT}8~g(LJLa2ef+{&D1}-~L&silVCGoK#%?&uoT?DB%_59Akl3VgymB!`S zs)cT1REKC+s`xZ))0cK!=o?brW_3z^V&Djt&xN_*32p`~rpN&Kq*4s75qv(}vElJN z$vb_XyOcoN4?An)$FNLkN(ao6o)cf&5Ss;o^)WA(+2)@sjXK)FZe#vEBfU(&o` zeH3>U6aHYP3Z>eK2XS~OkX&siTo~xEC)i73d{(w5#MFS;VKJtkXkC!-217QeO)c3Y zoW+VC0FS&tOjz47N+jVTVzD1#CzNNoPuuOVK<-{4GEd3W3o;|59Ly3jj4NAE`x1pCe(#=$Ffq@no#k_(@II`V$x4#WP!Nq-NKJsd0Pd;&vA?p`Zn zgmHx84;8f;IJ6S8>7+zpcP)H@{F_t&9hq8Hwn?`K1QmWv&1g~!6l|}WJu~*y&M08A zG*k`%L5}~3siI%S|MAxiC=2GeLSgBI#kp^2JgvJ2-0Xlh-4k;Tb#h-6vDhJtP~o>1 z_v1e{A3YrJujWQva+^?YG3kOCaT^8yfL_qv40M8Ksgqo4DEDTCW%J*|fxVrI$7wZT zgg6Gcm1{zY+u_mP3v}T_8JW?Kqhu#Q=g@s)c%H2^76mWd4(j(>PCS?&QLeUSsidYjI)u@>1P9K0pg@bceuNtlE#C(okpIHwy zo%;ZqA1W8N^>U5E^>pee`Rgux8q@H5WLr!%CY^)%B#vmj&27C`4?2B!J#JA@7nUSo zmOt<71ktI6IK9GhD{ghBLYVdXHd-&_KP&W2>cl*3;-Mxlf4-P->*>|S+oJ0=8_ttrFb^H%Ds+Wq_t>gdKtekZPl*L`0nQKPo+xe~0}Rzt*PjADF1AWKq8H z#Ww*3=&$_h?8*x9%uK*GD+BQVvldVc<;#mn4-)MH7*UO)UdZiFSS{Z39>W|f(hfIB zNhwKD>uq;%gr?2G?%l&8+JCdunxMlZS9(JK3#<72WjEdXLi7t(Z? z)OH~O6#;v?vn+lvgq)CT2v{hoT+2@g@MFn^V9`l(kP-_LXEFzev^3%+!@gr@v~pX{ zNH7!OXhi=5B7!bWjNf0$dB zKaG;-MTiJ6i7j-Evc~f`>adi*zIs0FxIvU7A~}sYB#OM?87eIrMuh|W z>_8$d^hul&DNoptLKaj6yQT4rM0mSH{f%s=7kKG!qf4rSaf*X5;x*p1P@_jO3)XPrKa#U=;*+;irZF6?fTpq}RJJ)zA zAqe>nYSFcTpmE44GV&4{i4|x$f$xd=;i-9Pr}ZF2>P2gPrN~wbYFDjXOp^icunMBL zcS#+UYS^96dI_}`bi%TJh&O^WQ0+9G*>B8ou;p%!-OQ<5i2KBs7#`J?m%)z4R9UIS zLqs7VUMnPD#I8chxiS2~BNf))Wtv@XjH3m!Pgi5>!mhxHFz`cFQa<*XWb8iFBH3Ic zFHt97;p7>TYM3JRagQEvf-MDRum7; zh<5_G2AeR3skA$PnM;B>7Q}grsdb?~Iz5Zpv4wGDM*98SRuP19_83$NYQso5*19ea=8S!Kx%^-vyO{(w$`Ah^ouwzz(xOA?*6>aRY7*WjGE|(%P6`l4(_* z)f16O+VZ|@8$%^PYr2({y=9{eB4u6$cCv7;O#_j9$kQowt>9%1*GIeiZUj+V|N3Ry z>J|y4i|PW7(#~h}KX%gh+gK*w3>68QvCi?}se5=co*elsOL7SRn#6aEoBTiGW(X;I z15&VtoiV9W<<@~fbpjr~G1&Ushp#M;W;4#Bg=PRoIOYhjd6Ym^;`IwzkMK?sI>yKgJqz3H;8 zlC=bLDZ)Gnn#EA;oR{8KqLD!>9n<3-XYt{zMO0Ei{Rx`eh&#w!ZR>{S^)#_xK@J~H zsnA$D5lU0)6+*nx*bOZryT7NbzW3BfT&z&-7YPuxs9{4!(bJce7Jje4+t_rt;hx3T zI8yUNI(9`~b{|t~lkr|lo{etO$78!o&X%Vsrr{T`h%{N7O3j!z6BqMka*ESJN=?R; zG&=LG7-w<8+~@Pd2@5U&7BjZQj&7DQy`n0-8touvvt&ba%AH+PM1NX;n=$-;dI7=s zi7Wr+zHA2mX|JHF(aISMvs<$!<#He;O7xM)-W2_t4l5N-8!Lv>1Sies&Yq}MKuDt^ z%9kB=)Mk5D8vL8hya^sNK51EbJ-*dD@f7>{jjO_CD%E`D3Ua1YJsql|*vZAHYKHoy zufQbK##?383{lrsUsh!|(%PPV2eZK`#%5-D6pM(uRBZM6q`hcfUp>TYL?uyB*^mD; zKDIbVIw&`=P9pnB0Sp7(7yWY1jkp1|g4bGD1|IrN`l(Jimrv;3y78 zuwf>J(qD+))U=|nnT{=SM(EP7JU9Nsh5YoYU%Ju**d%1L1AE4t&tN0HkYkkI+g6f% z$qqgpm$KnGg+2z)zybof8iB*fK<|-R{sY)pV zJL6DuCHC8^L_nP>I-AtdZjW4h|L?!_rfz)P)bdDT!0PrP#%6gbjLJB7I!nz=Qik)} zbW9Jvw>!hip2ST^F0Zvly!w3Z9XS=8&+VxX$YMob#2}@7D+Guf2BpKVEpsSMK`VdGs?u~U(=)XItRPJ zGYU%BD0RS1i=@31C+W(bB^4Im?q*qK`jC+B>YZW?5aYL|@NH!e2_7~uDXOiL`D9~* z*r|cRs~=skT3;`IA3SF90(k89QK#wYLn!Hu z%WQ^*wCC5*m9=nn<9d}23b0nDP!RkNNqP8p)??ldINthS_hte(7>(?C*M$Xr5|3RhZA|V)plMx0Q?}RJ!v+7;)Y;E+%mO+ zPFa*QR9)&CdI47#p^*#xi=pgBlP?M1h`*!8Z1F~i3@wdv<={wfgpxd5%*;?$c+VsT z^E*>(7}r&_NS&%7s2x=T27UlJMQ zUEG()O*fQspgJE8Qg?lhgjRTfpXUIBx?^j9_NcIAS7tRJoJHkny+WEMk7(IwCzXH~~^Kii# zSLwF4W+N%C(Cf62f$IO5^=UMhj`_2j2V=pbJN7o-+6K%?YZ9o3n2l@f{aorSO4~+< z{h~RggUF_@W6-;e;4L~ec@T?}QXB@PgOka$pa8XCo=7(_8Dp$pU5DiJq)OIr&w@Iu z=c2R-I;42IQ*U<|$pZA`8q$85^dMTd9-5V*RR(-=L%11=6JPVP3(k{_XAg6Antsg+ zT9<$p zm3g@8@A)hGnx<`!4w&qgGqq^&UYq_<^kYABF}{oOp5|kfjAiZxv|p5F#$7kAzXlu} zLOkZJifCjFnIw0mDRJ7)JCuUV9U&$EJe#&}W;+XLA%=Tc$VgQd)9>CDnCyVZt^C}r z!H%K%ux)dSKO3!4A~a^K1_K(ktdhdQ(wh-jO;au_JSJvdoVe?S;O=jkq;kE~Vbc`I zxb%%ZRKU000iOxXp!+z;_bv}tzVA6S0r?yT*mBs$5f+(KH11aBgZ#{vE>x5a=O<0f3~%GPdn}VxI^aQrJ!Ofj2S6 z$SmS|{^IaZo;+xHXHVR8;fkWak-A50u0ZoVcWyrrxv@2dq2LkWSAz<-jaLK zPMe2K7o0+>Q?dW)ZMc81qjr|ZDjyd02iagOn?O(W6zxX#SG@=3vID`EOwc@|Pw$MI z4*AnQG%!Ty8L)&d(WWcPb+!;8EOFf(`$bgrQ&Rg$)K_TJ2U#Y?K_)X;h%1GCG_mjB zZ}YuYq+ht+EJ;aYRqRj8_iugeew;{;fO60mr%`51aYRTHR5%8JX=n4OJ?;;KofQX$=(%m z)Jw+#CeEOQd9D4at{!=-Pj&bdE=%*xviEqemK2^^OMWo#WvrxD+3sckctQ#j;wbgL z6Tb*QsFmHuiu~88Ky+E-4$KX2a)Ug@0`C2sq}qMpW>}df)+F}p(_@bc(jEm0C3^G>O@Rq zJj+Ett#$kIrPQ*nqqLy7znqY zQS?5B24vkfD{oEba;q3?Y- zEAU)yC<`>H)TI#u|CyJqqa+v>?Rb_cNHXk4+0t^h;df5ymPmdm8D`x9oUmyj4dZ=B z!pm!dV1Ij_r&!y!=g34$Tk?OOxBvIL5IS6C(BMhGE0}6FDie*8nfELy2O)p64uBCm z4DPJ_%J?+YGF(bi9kH+NjxaajN@v(ct3cAikwCfAjNvNG0{F(s?#grpB)#hC;?|$gK+q(o)KJBul18zLO6bk-=39IZvGtKt2L=S|D)=lyuAm_=VN4fxc=5zgw( zPHzTBctXJso-UL)+Sh`gS;2=9vVE+)W@;~zd@t{7E}_J$KWw~;e-Hp@1{7YzLuh%Qx#TFO#H zk=h`Bj$K&TGd$61V69JenB4%4xu_8qCZ&H;fSZ?fTeFQX9H2xdr`F<-)AO~R5@m`h zHO4#3eW#$kx(C#9XM}CeGkZ}6uohUq-?MbbZv)@%7zqtAJ50+8Nc2E_mhvV;8`Zpp zK((JfpdUt|y7XwR433?Q-xuMN3e%e_9R$(LwccEb6K(GH=VvWRnd@Mq?BBL zSb>is_TP7abmS-L!TLt%SjMh`f$omSnqOZZrv@TAdvB&=sRBl+xXYcY*G}BDDn1K#yo%|Bv z{6a~0s4i;Vyv~+h4I=Q}HOTH>IxHX5iFkKpx#>sx?9a3!d;B{O23BN$n%E;{I)^CeFygJSovo z8QO^@h?vB~1oAwY*jd=MJSxI+-oh26^ z^BG;yrFRKC-uM#o#y3iRGc;(+1**|b+(R+YG+kt?hj-D+SrZgjCXPz*3o<&7hf6MV zxtQdjxz$~6sA;dH9Sd0TwKfTI(-gaiSfp zrzBDMi|oqU2$qD;Mz#!m2x_#3Rkgrw6WxlQtv=hg7pci+#UroZi& zVOcrCZsE+mlMM)|R-%Me9s@lb?5}>uiT|GQZ-uUIf^L<~*)v!(Y0_l~)>7A`1)$lm zwAfi6>>Z+)(xP@l2e072PQw2Zo8&pS{PJm7qDiSTqyB@UBP+>69W}$L*t{<7y|NkW z{AwxtJLGuU4aR)v-H;wK2|bCwq^NdNQppB)YO?)xG-uAmhE=3`YE=dCRt_OFl(-e! z0#pjFoD9om;X_3;qIq+AjC{G$|MGJ!cX#|g+%WnZcJO`fIfBY&uJiuILehz{`Chuq zoyEQ)PR=6S=u?rTv-)Yu(aMSfUZRQ|Qm%%*S;H8wRmeKzZbN~*uD;x$<_z1x`+*x} z8GL}`-T&-t;c0bYZ*_lcUBeod`35Q7G?Y_hwt~9NF4{3oK<1=qTo7XZj%4##`T= z#YFb^R($j06E5dnK}}R}T%A~WOnR8lZeJubG5F=i zWeZZa8e9K~!Xc$}p8k49e&t^OogXJIg061n^X%|ur)V{oNj9vqXbHxg=jat6?hyJL zc12?Wt~@RCt{%U6t=`@pzkZaEPJG?Ri%3ktK>CO5d+~Wb3z=o`)T>igKt+fhq%EtiM1XHZX%u8@ z7RyU%w7D(91FRwxqQ^iGK-h!U=GNB|CpA#^(ne4&S@;3Dl)KP~g*u1w!e!;-rOWn+ z4;K2*JiU!MDZZ6^-Z4AXd!wGa?Ga8tJ9ZinQtASoEg7Y&VlEY-6XdX8-754k|3k+0 zyNpK<$3U7*2Z*`HL90aKN0G;WT)dTDi8IHOE{zY=T!9#u>#-*Fu;4M9JiJUVl-kz* z(^j&yO-aRHS!qei<56H9$c{+$-XShxCEGXm`Sl*a?1ONc;83~7d*~7^TGHo_xqMe2 z0K9XsSTEB!D&iZ+em>xVwJP9pb{Mf5%hYRbgifHaFYt$pm7SbOs_YRv$nZ?xbQQAK z#tEmCa>z_6ZnPe*M#T8uLjM+9v(Dr|5fg-Dv$d1kilaoDYxukOCD$@kIat`G<4Et{ zr`GOrv!?7C(FwUet+wx%N1g?sm<+v^_0j=``6YAN)NOXkJ&16%Q87KX<3~8YaY+s3 zRq6XZl4?>yT!ZX(&q|X=7a|QHJPZ(uIR7^OA3QL+5kgFOhHso52R<6)kHo7!gxpB<*+@jo+2~D4C!szkTU#P#qf^9FOXq?<39L`-q}?nDU91!p zG|Qe(;|77XLl$OfhHU9Di`EiQLcJzB?Pqh`?Gqw3Q-L#rud2qG_a*o(p*%V(PW?uR zzxRE#cJc);o*7loWhDxceo2c=Lx+;ml+toYR>C1K$#=lnHqH0GdD_*eKo$?MqajRG zajxduje>i|L31*B`_|`d^L@9yx*jgjcjYD^8grMVuFv;whlxA!e1xr6Fd<_BU^q#d z*m2z}vSC>Jd0*?NW&)9YD`*@Dwzvg@k>3qh&0R8$_oQVu-SE60W zkA=nY=uUOj%MCG-Kr7>dzi^5i2dx7F%F}WpB(dUg5UyP`6}nF4oaqc+zj^-1o$+4T z9F@+Jmqx3d*dxGCG)gjZkVKx@huBH@B?tE5&acnwZ*(olJOZRVF2$EZXWWQ4ho+7! zQ!^Oz>~{AIe8a~8paZ$by;zzh8e7<_B^yivkAbV(HYds|McSVgn;!u05DWQ^2$y7M ziCEZdjyo|V&zg#&Chx&^s^qQ3mMT%qj0{I3}|Z*K1oJ>l`DA%!!J zG%78;e>{E6dMN^n%0OWsNEUCWXwsoY8UXh=ieLStNn#o$A0CPuoIz#njNadx7i4{J zybVGcR8q9}HDj>AP%7qV%g#XAqfN>6?r6>pds{fwP3s|MUK{+=?=d{WvNf%@( z`9zxpF~Ws(#1+&;tX$JHKYBD!T=FQBt)2RaH;3eg>_+wJ6yg8~DoeEL13ZwJ4R+-y zxEp9sZ+P;+!M)550LOohB+4iLq`=#M<@=)iVVGJzW?xQO-OlsD>~#5Qp$yY#d9&^Yav+@ap2r)Uz}whq zySTS&X*c`4z+p?+r6NPLtvDK-_AV0dnu+oC*oz?<`*!(J4Gj7Fbn%iy1m07ANqPLH zr6gq$FHZXpRWupTNU{vm5WYO}@1t9AVo7|Q|`GH7e;~L9c!}M`ft$Op4re@8ps-C(*zm zEV@DeHe;#M{Iht4h%TE~_^9k=LX6sgx}Y+O^@;!p*)Ku|CS5eCuh-wC^@61*Vy z=t*L;>>4Yi7A&)`x$p#lI#l|Pn5A#}U2$u_0fhF$K1DIHruKy3Otyr7OUP{T)Ys>n zf5iEzEl{;HV8#s%g>{pxnHQjBc>4b=O#1w(S91IC`Lxw+Sw+Q!B8F?nS>Zit3Jjv8 z@R`v91D*`f$&rUbDNOKkDa2hHZr$5ZzZ1@23(3{dH!a*A++Rh{Z=YRalvH~Jq&-iw zw)%zF{TGLBX5P-*rXU2Z*l;DTnwDSUnA><}^jjrbus5T{)+|-F3$?jX*Fl=Lc->(n zhAdL`#J}RUD9nb8%Z$}~<$h;ljo+biZ*W}wUYvs+O@ zqdlV^XE#}eV0lZ$Hwf0W;6NYD{3b(9!50IAS%sWrn(?AptLGa1yfgIMvDaL2-RHt` zO|A}8B0i$x#Ri|rgh-hIU-g@I4-v%I{Ozf`zV5Cnqm7oU^b5v^aNE$yPBrhW4nM_& zER;XoaR+7wce<9Y6u^&Pr&>HToNMIoGC2-`8=N0=_ojfe>ev^%oC1(~pEDE|*axSp zK1|$fkQPO)al$t)Pvc@J`uhx14EKWh-EkztTe&E;9=sfvk}}$lfNcE-uQJL`H3U{= zzV=x~hHh|F%x@$|M7=sSIDm$!2PX@NP0>$yYC(@Fl2 z1{hN<{^hVr4K)k5b^&E?z7V^_K{&68tc(AVeY^2#;9!M>lRC?aggW%WfV3w(v+6l% zd`@$8oX+cNrT^`R``!D@X@xq{KD|~N^bD+Av^2^ugnu+%cIXV32ZXT95xfkxEIU&e0;i;!7%R=4gX>ufK^&Qj9c-mY#^ZIXTU9!{e^b z#pGsx;LDiXun(Iu)|wY#;k|}>x%4_9sgml|h1fWW7!`?3%NvD|<92Y*a19S)Uks#K zZ+nY*)1W#w$zRU2ysonwbBDTTNLJ}Qe2#n5Kr(f-J$UI798;=3CrN2VPXvvMFh}t8 zecv6{KiQ4mFvE~YNb#;1s(})~POGQK6k_j+U7=BuixPE^7LrAJAAD2GKGA6mUVe`u zt?Fz_L~MH;Nas!K%79Cc431IKcN#c-&}LdrJ$(RMixrYJcN;{FMDcvUu4j^@;U`s4 z4eKeh^m0Xu64MGZuFjCT=2AkiH)`o!#R>v7{79rvT=Pi!1!k=*-J5HpN6Z)2yC&4R ziLFRGtlo{h(zG(G5mE>IuC;8LTx`iW`-|TsgJE~46P&vweKAcq=;$>UY%H}`j&E`CZv5<-08Y`1_vPH(K|_{lvh~w_Mub)vTt|mD^u|SIKK5z1 zp0maPqUw44OIAO5W<<$Z65z%nQ($On3s{)$V-daWv-K$I8-We^wJ=5Ql2^`>cSvh(x|StwY70i8nAm=iDh z5Acdp1HHgalZxbAQ82b3#2oR$cH()KGPlu>abzux*M&|u50gYkx%kKPYDE&LFA@uA z?&h?Wv;%B|cB}8n^y%|D7yCasan&sVNp`Na9{b$_KK(g26J!(s^%M&CG#_kx>N zQzvVKOeq?8Oby7Tf>7Ek+f9A4*%goYgqm*MjiT+pTg!kht++p2h#uD$P#9T>WU4zl z>$^)2E{e+kMHo>`-nC29u}7@wWj3JsN8MhZx*hV_vBw#OxfR_onSo}|`G2y_IsTD| z>>K~$jGb{zz2@fB_QLp7UHROfk92)Ea|#*7QT>OAyq_&bS=4Oj4^|z{0**Ib-ywG=!hS99pX5%-dw z>+7<=97boJoG+(~7YZLOJm7Q^#2b@Xoeu&B9+VK+pUQxw1KE!Vov2O?^;?_;FhCTY z1pOL*AF%*u75M+Pz2}iCtrEXGTZ5!bVH3Ga`&Ih!|8d3zuKKNiLJsst8-qxNya+uq zI}Q&(yweEGKZsk0;MU9`C+2&oo4jfgN#TZ~fxoSBl~))|JBDP-IQfl|TtQFMUI4z( zr*kiy40)N?jvqzk!;~A^v6(H^q&R%0wB5e}NYYZ*IYW|;f4l3IBiQBVQ_EV|#*uBD ziZlpxreI)c_e)On{awYO*LsNH0Iu9fJHUAh3aiV^Q9Xt|4$zzazh9B*pefI3zTdWo zyTw#ozfE_oIF;xZBoV8%II!_`1_L~CR;?!NW`X+=Wg?;TW5<-1Tj+=zPI_rj~$rj%xnWf7I-y=)^H?9Gqo^-G<4gCzeeo51Ae`Sk`7mJ>3I7oe@5 z)|MylUzghq;ZAIbB<+1ye?w!ce=x?fPnX8U#go&>0e;e&LG8zicC>8QcbkGW0F!IR zNRUk2e7QHipD`{nn-)wXYlvchu@wn=W4w?$GX4Zx``E2aQvw`(ajWXBq?F4(K(88a zBQg!>{OoW6hVbN`g_mfkSEu+Jv-l^_?eaCS-l& zB&CR`I@)SeJ%kZ@i2zT^jo4T+n2Cl9Xnhmw%(}pfTd^7Du7#TT61dew$UiOavN3?H$QoP zbXTM*!AO~=jE3~h9(`ToO2j8$I!c0NR|1!fTOvfkpkncgC-VKsrYZ2L9z2D8DY(pU zyHMFc7S<{*n3geB!?1368gV>5NKZs4!9VbHX19)#Kep_XLJgEX;|ONs-4lSHNoAJG zWKYMwC4d8(ye!YTF=WX1mesazep?gJss7hkQ=eQjot5KoUcdR{Bq&@26049z{dZ4E zb<$ev%m;Ys!CavBo|ZjgZ8OOIk=mHw!p4ntca9?G9)Ly-A(qOITl2QGlzf5Pa&*q3 z5lS$&gZi9@-AjpVi(3XfHEbR^%!qY#&3*4JM@;|#007XtxcmSCwz>n>fEVD;PNgkT>vQ&2UKVgRpfklJ zl5LXH8q+8Uu*G34G-w_*aZvphLXQqy#XEllPy5zGw?Cp|25mUPtgFp+Z#|9eUyP1| zQ$1efE~BQOuo)u87W($Nff!BR43OWy-cLnj2vc8-ftH$uJtc8kujG_z+_%Ilol#*h zT;M+6iFq`xium!vE#__u6`Qk0L`1_m{wC3DQNiqdTUBaLx3%&d@*Zt3?&R4+SSuK$ zZS$sJQbl$W@S>-KQt!H}h(CiO>XY=XP%e;NjR~8mntY)=D}fJ%y+WQu_WdH<{pl!_ zb^(?4GG>FW)7b&r@z|nwlPd|$M81$g7i_rXJxhlxEn*dpxs$|WNdg(jzi@~&bE-ym z)*DdFn()>(qY0&CgsrH8Z+R_d@hWh@GsXWDY$nCNFc+o$arGZ`NGL|^_}jyAZp#j_ z>i=6u4yNePNixl+(AeMP!)NuVQqOAC+6K4572+Iirj~iq*(Ux>2Mvj=@fHK zJXwR#r40SqG?+@n_|33)_L5l>tM72JA75;FTiXWKrWxp4O!5ydQhA04`;@A#8?*?t z{S$0N8meS1vObo+$i;ARpinrCC>qk=S2=T%EF2IJpP%FauwrtN0V@A&K;Gmda&9$m zXtuSSFekaE1?D4wtA~@h*I0EW(b8Chzd_#jO#nNJHn@9>dyDNH;=|IH-7I!)f1*;2 z_dKhVVH7g2ZF+>KC3)Fd7RMKMJJS%6ZVLZ2R<>erG*FByLJEmtUj~Ml zb#MimveoBhhVA3PHMF$0q&f7;RFSm{LpPN}WXN!$A6}p@E~QLrCAI!~Df_m2Fz<^s ze7~af7$+~a!_{a-jL&h)s&q|VHUNl!`ox^bJ?U6XNt8_7YVR1|liN&L$*d0?Y0^8E zZtH-qKfazrEMzTaA0EgIrhRW=D-;5X)qd=28N=92xcGzF*0Fm*628ww1@mq9Yf2jA&iI&N$dVo4JW3J#nsRotB7F(i=hBeTiJ z$%uaZ0J0sF9fISyf=L@Ce9&wpKsm9Bh!eB|?xL1m7%IRWbl?zvY)o1rzpSN<}H%+iHjAA*Wqz8uYN3>lka&H#VEP6^)eMqW5Krf#n`8O)ol;Vkkj z20Ix=(5Cmx$PxM_)q-<9oh>)bxE20O^p$~#`O1>XOM5oOhUq(sJ^)@aJ}NRRt!^ug zDVkczsH%Bq7WgiHpMuqvD2v5>UO~~m2bDJEo9WkJ?MoQ6o(aRH114H*>Ep#S6HlE1 zAR5F(Z||foew&b@KVsJE>5m%nx-3=GbyIHU@~lUB9j^hIHg%->IjKZUx(8+aI&Nm_-+xP$A6VtgV^ZH9YN@u+QizvWxOo z7^6IkSjd{Dnp9TG?x1gN*)?CoIBi1)V{8r>T)j40wQ&eb--{5wDL-jRZeF~QQyoqO z9xo9n2oUsQ6n{jTd~u**Y!p*&p!=o>rB{){#wQ2II~>(4eA$KS`V8r8+kSZ6zt7oB zh(LY(e`oc97fe3|9S@ldiVT zIKuV`E;4J0UD+(^eRHXYjN8DKhaur5^D5!;Na=bveRJ?*ngYB;<npbOz>zm^zKG6OP1gEe&>cD9qu|pZ` zH?c|v8j9W)$Di(6rI{y4q8{AQqld)OA3MZ&GR$xI{L8b`0AND&xZ>qJOdEN5(oaupQ<|r{m-O?BXQ5h z<29qH8r~q_NQ-fimI}Zl^)*V+!{nA`qBJ)8yum7R}{HDGk?A+xL|AuyNw8S8P@x}V#aqCilhUeXPp6xbj)?rQ3-oQgA9in z7yU0HZF+h3({)Z9W&Vr)3^AvKJY7k-3KkY3;j*31KvQs>8nlbo6@R1^;Ve&c8|m#? zl*j*4c4AqsaOA*cL?itMiEs)j`3liD!1D!9&*3n_knjHItjRU+@SMu9J=tX%PnpH})RtRe# z_++k@jqZ%Cf`!rZsNm!PJKrGmE^CUwV(;t}b)B35$=HH%O+tuFX+F^zEZ}^xy7&E> zMqx3bpuM#PX+uxE0cjyrR$&|j$?bRqhV%PN3XR6mxsuuBMR#rVWWaLBV)J4T|ITT^ zf^g`(TX5ju9eB;0BO9vJFHZ^pmiUxrVLAecTHT7k@j@!9Bv&wfCrl9NfwRsFOg?U$ z13%Vjs9(Vj2^iSuV)LFRO44}_j)<)Y=s&~uyuw|i=Jkpzo^7oc z6D7i17mhM(cW7DF&u=kO$q#yKaCJFqor}`|?E&55tQ5vGv?Vb=`%y;)DAHerRrh5p zS$r;*Po#a6o_Cg(KaZU9cfy+B9wW5+5X?{2of~QZ`qxcJ1UMZ^q@3(gLUddJxYvmC zN!{T_(+o&rzPT5a^KE9LwdY?{)SmL)1hwG3JTcP!-{fwz~5XOqkqQ?kYvD&M= z79kImT%2+mrW1AYCT(HqR0m}PNU%I{5ZEfc!X>>k2#J#|X{i15$KsJ@|6pw}->ptx zlYLdNmL*zmdZJNl9_dw?*lmbO(ut-2EBhi{Qd6TWx7E@m-R?C#xK8afW)8QQVt3~h zUhElANPgvlpCg?^ieZL&$b_aMkd8SX1(HeC#UdX>6t^vm*=JKaUG^^@tM`WMh<+=% z=j(@jENEd%>u=ryCP5Gvx5zJ=M}-jIZe|vT1gQtuhXjSFI6N&Jozx+XgMr6aJ!gdo z4DAsQRGL#pAx>-vvq2ju6%$Nww$~mc>Vdg-!Ri@iN#Rrb`{+VAVB8tCQ#LvpQ5u=- zWYInpAd!Gj+C@EO(?*#WcxBjjXd}R1NQsZR7b0{l+1^*f!pQy}+{$6?WXXV z$5NYi4Hdh^F~`9Y7|mPBQ9#y8_eFQVf6`_fAiXwKtvl1HcUKIX5u#ba)tQIJC>|Gr zR0F!URz)~$xZ@}mu8~J>Yjin>Vi4X!@&BM&-bO=XID0&e>zSX&Km+7Dvc8m-OdL96 zP~GrLO+PWKfH`^F+PTx9a)4HY;0{^Q=b53Mib+O$D9<);j?szY1i9;r4==!a)s=l^ z-aE@|o#N2Ze?iVdJ?@sN)E**W&%PLx)iP+xGjQdh^l#naa}l1c{v0PMn@TeQjIi}9 z!NOF#SE+yM&p6F5H0RpaspI>gV+p^?9h>K1KGli~Nu#e}WrMUs@lOwy25$4Lz>0n~ zt56S~X9&kT@qnJV1~dH$#p`cd2D*I?Ou)T=fvLPa_Aa(Y^Ur3jX3H?XkQrlgmJ>J1 zXq&cVyA{rn@MRm@a47A(5H3#B5y3AeRgT4;E9S~tYnag6&AudVKP>xqV8qWxaB~^11VXr04`fEo;CXSzT|6FR3oTZZ|er`01Dn zivK#|I5Yj@B$c-MR8I8osjKIthGILo+JH8iDPSbpA|8*w1c_+MSpflkBjWYs#r8pv z(k93n+@OGV=3Nx7yj4Ebw>Xdj(@*~9zHn2N>vjy^R88D!(}Ts!IPZ<;)eT>hoX`D! z>=$OR4hY$eI}oh$mJJPqg`o!spGu17m;jr_Ti;jC|GFM_9G|0nWoFu~w8G|B$NG4-Bkk>4(DdOA6D!bQH| zK8%jTx^+p~UO@#j z_9WG7|3dqb=WGk(8qrTofU>8dj95~jUq!joUXQ=!9N_g<=mhT9ZPGRR1_lD43;M`# z;-qQUyQBF~YH+&Kc$4akcanKk-1l^#@J>Zb$5=fdI=E%3%d&_mQH3&MXw=iD|}GI2zwt9Joc(zuNX1&vw;;Oj}pRJ?8zWb6(X0weAYDgHMou$($vMqAMJ* z)>2OJJzWb%WRM8sJcMb}AbWZ_8Cd06sp$9216PDP4ZMC{`BTI!&A7Lye{SwvaBaN? zt!uRs#Zw@#JGYPlF&%fdTDQEQ-jh!Zo>(m*h+5TwzeGZ>lhH1uVXD?^Wsri(6-s{h z$m1i^;}NA-&xHN{Mf(T6gQ#tRJpBok=Ih<}j6Xa?w*BXip-`P&gWHVEem*RS`Ky*t zdMA<3J*y`iOV7l^!D954m}^^1bnRRO5g|4>G4k8MDe<`VFE<%@iGZvWyZ^)(<&FG8 zsC;mTh#S9|0G=MXj)C8^grbqeiwoQIs7c^j;n zV)Lrfl3I~@3t~wQF{vLUKKCh(TR*k^Uw8D0$|q|4PQKI7^PBY&LIMlr`UX)*W<6g~ zdzy+u1_Z%7r=Uc;)+Rt3JL?FZbDP|^k+S0r3VWTs*Bfm7TDkp;=M*@7(#p3-ccOKZDyHrV0*Wi78732#p<#8#{R8V4>BC%G{75dG znMu7O=>k8jazg<7jL>Fn$;A+fj~E*Mr@kYVT%(m2EqB^e#W3lO!lk z=+0?Y>{yb`Fs`x&qe&zz+j~!#M0D_o=5wIP^DN3hlJ;x|YeX!pxS41MaNV1)A3Fdr z6sz}%sWmrl)B|T!*e4XxG7nj42jWq##egcM!LSeiydhoZ)&6*7L+#|66o@J;+-z#0#i_6ejj^$rG5r)#cR?j4k79ceeD29F8lJGKO4XHYpn#AWp&d+J{~9u-u9 zSUBR8zZT#YTKf*iVbpz|3SZyg*OiP0GR2ml&gGAm@{t!Zx>z+p1Yw;iG5TL?!_@Mc z^Aye`&RBeB0jar;XOsq!s!KvE0J)sT2C*Fd5<;q~UkvVEGI63YCmH4SGCgwmM2KBi zUdx50PVAL9Kv-1aqj87DZq7^?#nzoQ*oyD?Bki=jpK>PfgB(>!?XsFAj!+_=r?9HC zxXe68z2Hm8XW=*C2e*@j`Z85;DLYD>nBx;DToeH!_l9a3P{0Fy&4=NoNlXd$*ioZDtsPiUj<2*4_N!)+ zq4zWB@qom=!MgC>*AsPH2$R3>5=$zN!GS3yj5A3*t;8hK5WWjsFVW!BeV!j($Oge`vx&~>Uy$#d)Pk9X?3k76klrK z5t3qy*L=hru<^f<=LlA&6c8Ohqho*5(rqRuSuSi3JGN#*Tc}#qSU%9hsuYj2cG8-{ zSlriH{ueur&Sr|M`vpFL<{ShGS&YjrZ~EpN9<{z4(rDKF_Ct6ioADNCXj1(a)~cD9+?h`g9aNXq@h)@WS1B41m@5S+7=)b$@jQGVh`8S zB8@@(z7|tOgV&N`faM}%hyCw-5a{UJV>XeH?QsC^bm-5yJ-YtKDo=*sjDu;V>JWYj z#4aGahWa0-n4c^ZB}OC7dDztgW^}p_x|YboBUY)o1s&6!GX9osILrwCtR@FUhzKj* zP4RezenB?HNN6xXGgSUpWjI_UD%MJr5Yo%g(^>nwMqa38KCr<{Tcpw+fo_JUbjB$vt7Vw04X#k8I=sSRFW5Q@EjJ8miy&N-Zuv zfCNL-Wrul33PeZi^7(-sd~vbIM_WwfFp*<IOkye~Khgo?CcE zRM)ARcla~{g|-2xqM@4sHwc`RcXN;VmtIw98IGl(o2N){>+Hht-G-{&Ee)HR+{41? z4mWOFTODWtJQ5JpuTB;E>msX2h+9brC3P#ay(E*!W?N8Azc*VStUFyzu)Q@J`YyzZ zD&?<$y9!V6`v{STe_(ZR*ZTMU102C%y$JEiD45d9z?;v@+3u}?_$;)y8p{NvxIT9_ z9~odl{&Tp9RO919I&vd*H!^$w?te{=gk;2Ti%^+{m=^+c-MDIMqKX1DK=zcVGqNu3 zNdpYyIbk5xod8|WuVJ1x3nVPLl_l*31OdEpn3E&)S}(5qo-lzY#Q z5SR7?u~&$k{nfFq_dNx%w$e%hyTn@xF!cUn6BvphcRPadGK~<>g1Tu87pqyTIazqT zP@EUTt{_W{1P?VaMbn4{@hD2?@d=S=^3RaIv&cNl!Ty3yamwr*F=fDql(viG(TM9& zL8{!5WwY7TkecAK+cTvlK{*H?y-CPFG56A*GZ4q zyH+JCXUR6O03g-aRToE@9MAn%k-ua@T%(;0EWt{-B|)C_oGx%kuDSmVl2zPfetb*e zN5}{kA%YqvEKFAVyI69G6`rzvwV jAD)lB0Kabj4{opjNTNIY|wd$lcj_;A)^_! zA5Z2dCU3kuL8vWBd;s~3qG$&!`FUn*jXw-dj=M02QPeAKEhu>oBI2Au10o+7uNID9 z`2%qT|F_EN|63?xI+Z8^Y_Q0cTX7$~{tT0^gWPNd6~&loc>N+a}(SkEN{D(@)GSib8tB z52<*tI~GWRJXRIH$X+=&$~D)aM)7wYM8Bs~4@)f)k;?!?<}wA*HjY2$AJ039%i#O& zRWjcC{Uk$Nl|9Oek?AYnU`OAtac=L0QzcdYE~J$d|NM? zyFH~`Ict;^vKyBHm~|9nJO=ekc!Of?*%zPRf?R{f{B|B+yUug{(VVIf@m$s%9jGqF zXwsb(JQI;>xInfV<(BgK{fw3`f@4W7Wv-7PgyY$s4qBx|BLLY^C5d@TIFCUZhgW6c z<6=JqSay~ENTZn02XLkm=XR;2+x}yZ6~NQTs`HfM<>Ppwb%Tz4qK8 zhOTV0^G|nc4dcS+w$-$7RdVua#c8R6y1{O}3m}7WSsN;)Z>pV}L8jvKFY<~NerD0U zPlW%2^?$)%RI%O2mtO>#ueJ1ypu1*+_&6EP&w`n}Etj?D3uzvjF~-cL4^6U1laChY z_?QU1b~*(O<{)(VcV}*Cs`)(xXF6mf5xtqP|KCW!s{;&@0okvG^|E181&9~R{qfgG zoi>=Ue-kOOh`5uD>I52ZAJNZczW%;b>=A;vBu|Ae{X35)50B0K1U;goQQ)GBbkprB%7q)&8Z_7Sr@k zV)&a&q9AMIVepG*kYyr^4j{KiDy?jnKpiT6XyR}~&!+_|##ZYC#*E%By{hz0b{+h8 z`KV+rr1hIH-LLwI_aqnAuXILvjJyC`D9d{8`$)x3+Ha!RS=Hu}Z+`kw91=L3rSS$^ zSvjZY;W8%Ed0V?#8g?YpEMkvl(EeQgr}}s*M=?SfUto{0S)Sv;JH*Q#!oYZJX{@T) zQs$WuxPcF)B{!v=%H{3@fRQad??L&RpZu|2Py<&jk`_~%X<`Nk zlOP2nl$SG5tBt1#r@2{R^>>ZQH2ua)_%HZrSJrz>H|h%u>e#AC<=o$OwZ~kilulB} z|FkSic9eq^0YJtHq>d9MhGM}4(#5FgIs1o({0+mpix1!E5yyZ1ahI@jC!t|DXhuK@ z7mB?3=#OtuJIovCs^Ky)XCh)ySq4nM;g^C#dMv*TTs~5l;cUA4r-vbzA7hxuX3on% z(PWpV4s1*&3kFF6>CS}gb{&Ss(5C`my#KQ{y22}P6EWlOcNHUb2a2p!nU+-bnX_jF zJL%YDRl{qlo!eU`6b3Ui<$Ck_%|t+R z0`1mM?i_xcx2!HsE|-Y+Wrk1|mln??9frtQlfu~qiEN78w7zc%m@RPj{=QpyZP>N9 z4^Hdt)s~~e6%LUkeAf9iQ;2I0sMMZ|gcmCImrfwQQx_rQ#976v)wWTMI`+H%95xem z;*?_^Kh7%+$uK{al!O>=fVAu};-sZU+}=#tH~G}>AzlcD62nFZ002A|UY1YVfmOCB zMx)7JooHyEf%ln=0dKKvnu5s6@7L&mO`!i;?e0UBTbBAw$r4^+UAn*hrtFAcY`6H_ zTGjFdn|6^Ar_O`&`ODy+zJ6 zW`aIb^eZ2s4pDJY;@fe8(%PG5*C+p1PWw8_MuFouEm{N>t;#pYWE#t+JdO;vq#*{} zuGEx^qnhoX5|p3Kgx4~){9H#osgxh&G_j=4XntVuUEh|EUMMXaQ^U%nW)miRgoqK! zd8%IbD_aVBvj|W1S;~f(#ZwF+ZB&W0F25)B#WC_N6{BNFH;slDZb4DeF@vC z&j7@!LGt$q@^YOXZ%{2~EdOd=Itppl1sHgGxW2B*C3UGT@y3lHx281`iJx-$ShS9m zT8{I9Zo7qrA>E@?!L>{ce&ho=Zf*NUI-1drHObbhW3PcisWze*VFlzq4uHLPnTpb( yzL. The data are the `lendbase` +element of `r4ss::SS_output()` with columns renamed to stockplotr's +conventions. See `data-raw/bigskate_comps.R`. +} +\details{ +Compositions are sex-specific, with female and male proportions summing to +one within each year, fleet, and partition. `Fishery_current` has separate +retained and discarded compositions. +} +\seealso{ +[bigskate_caal], [prepare_comp_data()], [plot_comp()] +} +\keyword{datasets} diff --git a/man/example_comp_data.Rd b/man/example_comp_data.Rd deleted file mode 100644 index 2da297dd..00000000 --- a/man/example_comp_data.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{example_comp_data} -\alias{example_comp_data} -\title{Example composition data} -\format{ -A tibble with 1080 rows and 8 variables: -\describe{ - \item{comp_type}{Type of composition ("age")} - \item{fleet}{Fleet or survey name} - \item{year}{Year of the observation} - \item{sex}{"female" or "male"; proportions sum to one across both sexes within a year and fleet} - \item{bin}{Age bin} - \item{observed}{Observed proportion} - \item{expected}{Model-expected proportion} - \item{n}{Input sample size} -} -} -\usage{ -example_comp_data -} -\description{ -Simulated sex-specific age compositions for a fishery (2001-2020) and a -survey (2005-2020), used to demonstrate the composition plotting -functions. Observed fishery compositions were generated with dome-shaped -selectivity while the expected values assume asymptotic selectivity, so -the fishery shows a pattern of misfit at older ages. See -`data-raw/example_comp_data.R` for the simulation code. -} -\seealso{ -[prepare_comp_data()], [plot_comp()] -} -\keyword{datasets} diff --git a/man/plot_comp.Rd b/man/plot_comp.Rd index c7606671..88e6e410 100644 --- a/man/plot_comp.Rd +++ b/man/plot_comp.Rd @@ -17,7 +17,7 @@ plot_comp( \arguments{ \item{dat}{A data frame of composition data in any format accepted by [prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` -table, or a tidy data frame like [example_comp_data].} +table, or a tidy data frame like [bigskate_lencomp].} \item{show_expected}{Logical. TRUE/FALSE; overlay the expected values as lines. Ignored if `dat` contains no expected values. @@ -35,13 +35,16 @@ more than one. Options: "age", "length", or NULL (keep all). Default: NULL} -\item{fleet}{Character or numeric vector. Fleet(s) to keep. NULL keeps all -fleets. +\item{fleet}{Character or numeric vector. Fleet(s) to keep, matching +either the fleet name (e.g., "Fishery_current") or the fleet name with its +partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. Default: NULL} -\item{show_n}{Logical. TRUE/FALSE; label each panel with its sample size -when sample sizes are available (not used when `aggregate = TRUE`). +\item{show_n}{Logical. TRUE/FALSE; label each panel with its adjusted +input sample size ("N adj.") and, when expected values are shown, its +effective sample size ("N eff."), as in r4ss. Not used when +`aggregate = TRUE`. Default: TRUE} @@ -68,17 +71,22 @@ If more than one fleet is plotted without aggregating, panels are created for every fleet and year combination; use `fleet` to focus on one fleet at a time. } +\section{r4ss equivalent}{ + `r4ss::SSplotComps()` subplot 1 (by year) and +subplot 21 (aggregated across years). +} + \examples{ # Observations only -plot_comp(example_comp_data, fleet = "Survey", show_expected = FALSE) +plot_comp(bigskate_lencomp, fleet = "WCGBTS", show_expected = FALSE) # Observed and expected -plot_comp(example_comp_data, fleet = "Fishery") +plot_comp(bigskate_lencomp, fleet = "Triennial") # All fleets aggregated across years -plot_comp(example_comp_data, aggregate = TRUE) +plot_comp(bigskate_lencomp, aggregate = TRUE) } \seealso{ [prepare_comp_data()], [plot_comp_bubble()], -[plot_comp_residuals()], [plot_comp_sex_ratio()], [plot_comp_mean()] +[plot_comp_residuals()], [plot_comp_sex_ratio()], [plot_comp_francis()] } diff --git a/man/plot_comp_andre.Rd b/man/plot_comp_andre.Rd new file mode 100644 index 00000000..030582d2 --- /dev/null +++ b/man/plot_comp_andre.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_comp_diagnostics.R +\name{plot_comp_andre} +\alias{plot_comp_andre} +\title{Plot Andre's mean age at length for conditional age-at-length data} +\usage{ +plot_comp_andre(dat, interval = 0.9, fleet = NULL, ncol = NULL) +} +\arguments{ +\item{dat}{Conditional age-at-length data in any format accepted by +[prepare_comp_data()] with `conditional = TRUE`: a tidy data frame with a +`length_bin` column (see [bigskate_caal]), or an +`r4ss::SS_output()` list (its `condbase` element is used).} + +\item{interval}{Number. Coverage of the intervals around the observed +values. + +Default: 0.90} + +\item{fleet}{Character or numeric vector. Fleet(s) to keep, matching +either the fleet name (e.g., "Fishery_current") or the fleet name with its +partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. + +Default: NULL} + +\item{ncol}{Number. Number of facet columns. NULL lets `ggplot2` choose. + +Default: NULL} +} +\value{ +A `ggplot2` object with one row of panels per year: mean age at +length on the left and standard error of the mean age on the right. +} +\description{ +For conditional age-at-length data, plot the observed and expected mean +age in each length bin, and the standard error of the mean age, for each +year. These are "Andre's plots" from `r4ss::SSplotComps()` (subplot 12). +} +\details{ +Within each year and length bin, the observed and expected mean +ages are \eqn{\sum_a a\, o_a} and \eqn{\sum_a a\, e_a}, and the standard +errors are the corresponding standard deviations of age divided by +\eqn{\sqrt{N}}, where \eqn{N} is the number of fish aged in the length +bin. Following r4ss, the interval for the mean is the observed mean plus or +minus the normal quantile times the observed standard error, and the +interval for the standard error is based on the chi-square distribution. +Observed values outside the intervals, or expected values that +consistently differ from the observed values, suggest mis-specified growth +or variability in length at age. + +Length bins with no observations or no sample size are omitted. Plot one +fleet at a time with `fleet`, and subset years by filtering `dat`. +} +\section{r4ss equivalent}{ + `r4ss::SSplotComps()` subplot 12 ("Andre's mean age +and std. dev. in conditional AAL"). +} + +\examples{ +plot_comp_andre( + dplyr::filter(bigskate_caal, year \%in\% 2016:2018), + fleet = "WCGBTS" +) +} +\seealso{ +[prepare_comp_data()], [plot_comp_bubble()] +} diff --git a/man/plot_comp_bubble.Rd b/man/plot_comp_bubble.Rd index 8c8c6b68..3e87ce6b 100644 --- a/man/plot_comp_bubble.Rd +++ b/man/plot_comp_bubble.Rd @@ -10,13 +10,14 @@ plot_comp_bubble( comp_type = NULL, fleet = NULL, max_size = 6, - ncol = NULL + ncol = NULL, + conditional = FALSE ) } \arguments{ \item{dat}{A data frame of composition data in any format accepted by [prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` -table, or a tidy data frame like [example_comp_data].} +table, or a tidy data frame like [bigskate_lencomp].} \item{value}{String. Value to plot. Options: "observed", "expected", or "pearson". @@ -28,8 +29,9 @@ more than one. Options: "age", "length", or NULL (keep all). Default: NULL} -\item{fleet}{Character or numeric vector. Fleet(s) to keep. NULL keeps all -fleets. +\item{fleet}{Character or numeric vector. Fleet(s) to keep, matching +either the fleet name (e.g., "Fishery_current") or the fleet name with its +partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. Default: NULL} @@ -40,6 +42,12 @@ Default: 6} \item{ncol}{Number. Number of facet columns. NULL lets `ggplot2` choose. Default: NULL} + +\item{conditional}{Logical. TRUE/FALSE; plot conditional age-at-length +data (see [prepare_comp_data()]), with age on the y-axis, length bin on +the x-axis, and one panel per year. + +Default: FALSE} } \value{ A `ggplot2` object. @@ -58,12 +66,25 @@ residuals (observed < expected), with bubble area proportional to the absolute value of the residual. The maximum absolute residual for each panel is included in the panel label. } +\section{r4ss equivalent}{ + `r4ss::SSplotComps()` subplot 2 (bubble plot of +observations or residuals) and subplot 3 (conditional age-at-length). +} + \examples{ -# Observed proportions; strong year classes appear as diagonals -plot_comp_bubble(example_comp_data) +# Observed proportions +plot_comp_bubble(bigskate_lencomp) # Pearson residuals -plot_comp_bubble(example_comp_data, value = "pearson") +plot_comp_bubble(bigskate_lencomp, value = "pearson") + +# Residuals for conditional age-at-length data +plot_comp_bubble( + dplyr::filter(bigskate_caal, year \%in\% 2016:2018), + value = "pearson", + fleet = "WCGBTS", + conditional = TRUE +) } \seealso{ [prepare_comp_data()], [plot_comp_residuals()], [plot_comp()] diff --git a/man/plot_comp_mean.Rd b/man/plot_comp_francis.Rd similarity index 71% rename from man/plot_comp_mean.Rd rename to man/plot_comp_francis.Rd index 4ad2c879..97585fb5 100644 --- a/man/plot_comp_mean.Rd +++ b/man/plot_comp_francis.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot_comp.R -\name{plot_comp_mean} -\alias{plot_comp_mean} -\title{Plot mean age or length of compositions over time} +\name{plot_comp_francis} +\alias{plot_comp_francis} +\title{Plot mean age or length with Francis (TA1.8) data weights} \usage{ -plot_comp_mean( +plot_comp_francis( dat, interval = 0.95, show_francis = TRUE, @@ -16,7 +16,7 @@ plot_comp_mean( \arguments{ \item{dat}{A data frame of composition data in any format accepted by [prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` -table, or a tidy data frame like [example_comp_data].} +table, or a tidy data frame like [bigskate_lencomp].} \item{interval}{Number. Coverage of the interval around the observed mean. @@ -33,8 +33,9 @@ more than one. Options: "age", "length", or NULL (keep all). Default: NULL} -\item{fleet}{Character or numeric vector. Fleet(s) to keep. NULL keeps all -fleets. +\item{fleet}{Character or numeric vector. Fleet(s) to keep, matching +either the fleet name (e.g., "Fishery_current") or the fleet name with its +partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. Default: NULL} @@ -63,17 +64,23 @@ Intervals are drawn around the observed means. The Francis weight is \eqn{1 / \mathrm{var}(r)} where \eqn{r = (\bar{x}_o - \bar{x}_e) / SE} are the standardized residuals of -the mean across years (fleets need at least three years). As in -`r4ss::SSMethod.TA1.8()`, its 95% interval is calculated by bootstrapping -the standardized residuals (1000 resamples), so use [set.seed()] for -reproducible intervals. The weight assumes a multinomial likelihood and has not been +the mean across years. As in Stock Synthesis and +`r4ss::SSMethod.TA1.8()`, all partitions of a fleet (e.g., retained and +discarded) share one weight, and its 95% interval is calculated by +bootstrapping the standardized residuals (1000 resamples), so use +[set.seed()] for reproducible intervals. The weight assumes a multinomial likelihood and has not been adapted for Dirichlet-multinomial or other likelihoods. Without expected values, only the observed means are plotted. Without sample sizes, no intervals or weights are shown. } +\section{r4ss equivalent}{ + `r4ss::SSplotComps()` subplots 8 and 9, which +use `r4ss::SSMethod.TA1.8()`. +} + \examples{ -plot_comp_mean(example_comp_data) +plot_comp_francis(bigskate_lencomp) } \references{ Francis, R.I.C.C. (2011). Data weighting in statistical diff --git a/man/plot_comp_residual_dist.Rd b/man/plot_comp_residual_dist.Rd new file mode 100644 index 00000000..b057510a --- /dev/null +++ b/man/plot_comp_residual_dist.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_comp_diagnostics.R +\name{plot_comp_residual_dist} +\alias{plot_comp_residual_dist} +\title{Plot the distribution of composition residuals} +\usage{ +plot_comp_residual_dist( + dat, + type = c("qq", "histogram"), + comp_type = NULL, + fleet = NULL, + ncol = NULL +) +} +\arguments{ +\item{dat}{A data frame of composition data in any format accepted by +[prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` +table, or a tidy data frame like [bigskate_lencomp].} + +\item{type}{String. Type of plot. Options: "qq" (normal quantile-quantile +plot) or "histogram" (with a standard normal density overlaid). + +Default: "qq"} + +\item{comp_type}{String. Type of composition to keep when `dat` contains +more than one. Options: "age", "length", or NULL (keep all). + +Default: NULL} + +\item{fleet}{Character or numeric vector. Fleet(s) to keep, matching +either the fleet name (e.g., "Fishery_current") or the fleet name with its +partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. + +Default: NULL} + +\item{ncol}{Number. Number of facet columns. NULL lets `ggplot2` choose. + +Default: NULL} +} +\value{ +A `ggplot2` object. +} +\description{ +Quantile-quantile plot or histogram of Pearson residuals for each fleet, +to check for heavy tails, skewness, and outliers. +} +\details{ +The standard deviation of the normalized residuals (SDNR) for +each fleet is included in the panel label. Values well above one suggest +that the compositions are given more weight (larger sample sizes) than the +fit supports. Pearson residuals for compositions are not expected to be +exactly normally distributed, especially for bins with small expected +proportions or small sample sizes, so treat departures in the tails with +some caution. +} +\examples{ +plot_comp_residual_dist(bigskate_lencomp) +plot_comp_residual_dist(bigskate_lencomp, type = "histogram") +} +\seealso{ +[plot_comp_residuals()], [plot_comp_residual_pattern()], +[prepare_comp_data()] +} diff --git a/man/plot_comp_residual_pattern.Rd b/man/plot_comp_residual_pattern.Rd new file mode 100644 index 00000000..f14db601 --- /dev/null +++ b/man/plot_comp_residual_pattern.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_comp_diagnostics.R +\name{plot_comp_residual_pattern} +\alias{plot_comp_residual_pattern} +\title{Plot patterns in composition residuals by bin or year} +\usage{ +plot_comp_residual_pattern( + dat, + by = c("bin", "year"), + comp_type = NULL, + fleet = NULL, + ncol = NULL +) +} +\arguments{ +\item{dat}{A data frame of composition data in any format accepted by +[prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` +table, or a tidy data frame like [bigskate_lencomp].} + +\item{by}{String. Summarize residuals by "bin" (age or length) or by +"year". + +Default: "bin"} + +\item{comp_type}{String. Type of composition to keep when `dat` contains +more than one. Options: "age", "length", or NULL (keep all). + +Default: NULL} + +\item{fleet}{Character or numeric vector. Fleet(s) to keep, matching +either the fleet name (e.g., "Fishery_current") or the fleet name with its +partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. + +Default: NULL} + +\item{ncol}{Number. Number of facet columns. NULL lets `ggplot2` choose. + +Default: NULL} +} +\value{ +A `ggplot2` object. +} +\description{ +Plot the mean Pearson residual for each bin (across years) or each year +(across bins), with a runs test for non-random patterns in the signs of +the residuals. These plots summarize the stripes that can appear in +residual bubble plots, for example, consistently negative residuals at +older ages caused by mis-specified selectivity. +} +\details{ +Vertical lines are plus and minus two standard errors of the mean +residual. The runs test (Wald-Wolfowitz) is applied to the signs of the +residuals ordered by year (when `by = "bin"`) or by bin (when +`by = "year"`). Filled points have fewer runs than expected by chance +(one-sided p < 0.05), which indicates a non-random pattern of residuals. +When all residuals have the same sign, the p-value is the probability of +that happening by chance, \eqn{2 \times 0.5^n}. +Residuals are summarized separately for each fleet and sex. +} +\examples{ +plot_comp_residual_pattern(bigskate_lencomp) +plot_comp_residual_pattern(bigskate_lencomp, by = "year") +} +\seealso{ +[plot_comp_residuals()], [plot_comp_residual_dist()], +[prepare_comp_data()] +} diff --git a/man/plot_comp_residuals.Rd b/man/plot_comp_residuals.Rd index e8484303..84ad13c5 100644 --- a/man/plot_comp_residuals.Rd +++ b/man/plot_comp_residuals.Rd @@ -9,7 +9,7 @@ plot_comp_residuals(dat, ...) \arguments{ \item{dat}{A data frame of composition data in any format accepted by [prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` -table, or a tidy data frame like [example_comp_data].} +table, or a tidy data frame like [bigskate_lencomp].} \item{...}{Additional arguments passed to [plot_comp_bubble()].} } @@ -21,12 +21,17 @@ A convenience wrapper around [plot_comp_bubble()] with `value = "pearson"`. Residuals are taken from `dat` when supplied or calculated by [prepare_comp_data()] assuming a multinomial distribution. } +\section{r4ss equivalent}{ + `r4ss::SSplotComps()` subplot 2 for residuals by +fleet and subplot 24 (residuals compared across fleets). +} + \examples{ -plot_comp_residuals(example_comp_data) +plot_comp_residuals(bigskate_lencomp) -# Compare residuals across fleets for one sex +# Compare residuals across fleets for females plot_comp_residuals( - dplyr::filter(example_comp_data, sex == "female"), + dplyr::filter(bigskate_lencomp, sex == "female"), ncol = 1 ) } diff --git a/man/plot_comp_sample_size.Rd b/man/plot_comp_sample_size.Rd new file mode 100644 index 00000000..3fa3d042 --- /dev/null +++ b/man/plot_comp_sample_size.Rd @@ -0,0 +1,90 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_comp_diagnostics.R +\name{plot_comp_sample_size} +\alias{plot_comp_sample_size} +\title{Plot input versus effective sample size of compositions} +\usage{ +plot_comp_sample_size( + dat, + comp_type = NULL, + fleet = NULL, + show_years = FALSE, + ncol = NULL +) +} +\arguments{ +\item{dat}{Composition data in any format accepted by +[prepare_comp_data()], or [convert_output()] output from Stock Synthesis +that contains the `FIT_LEN_COMPS` or `FIT_AGE_COMPS` tables (as in +`stockplotr::example_data`), from which the adjusted input (`nsamp_adj`) +and effective (`effn`) sample sizes are taken.} + +\item{comp_type}{String. Type of composition to keep when `dat` contains +more than one. Options: "age", "length", or NULL (keep all). + +Default: NULL} + +\item{fleet}{Character or numeric vector. Fleet(s) to keep, matching +either the fleet name (e.g., "Fishery_current") or the fleet name with its +partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. + +Default: NULL} + +\item{show_years}{Logical. TRUE/FALSE; label each point with its year. + +Default: FALSE} + +\item{ncol}{Number. Number of facet columns. NULL lets `ggplot2` choose. + +Default: NULL} +} +\value{ +A `ggplot2` object. +} +\description{ +Compare the input (or adjusted input) sample size of each composition with +its effective sample size, the sample size implied by how well the model +fits the composition. This is the diagnostic behind the McAllister and +Ianelli (1997) data weighting method. +} +\details{ +For each composition (year and fleet), the effective sample size +is +\deqn{N_{eff} = \sum_b e_b (1 - e_b) / \sum_b (o_b - e_b)^2} +where \eqn{o_b} and \eqn{e_b} are the observed and expected proportions in +bin \eqn{b} (McAllister and Ianelli 1997), the same calculation used by +Stock Synthesis. + +Each panel shows a 1:1 line, a loess smoother (dashed red, when there are +more than six distinct input sample sizes), the arithmetic mean of the +input sample sizes (vertical dashed line), and the harmonic mean of the +effective sample sizes (horizontal dashed line). The ratio of the harmonic +mean effective sample size to the mean input sample size, the +McAllister-Ianelli weight, is included in each panel label. Ratios below +one suggest that input sample sizes are too large relative to the fit. As +in Stock Synthesis, the weight is calculated across all partitions of a +fleet; multiplying it by the current variance adjustment gives the +`Recommend_var_adj` reported by Stock Synthesis. + +Effective sample sizes from this formula are not appropriate for +compositions fit with a Dirichlet-multinomial likelihood. +} +\section{r4ss equivalent}{ + `r4ss::SSplotComps()` subplot 7 ("N-EffN +comparison"). +} + +\examples{ +plot_comp_sample_size(bigskate_lencomp) + +# Stock Synthesis output converted with convert_output() +plot_comp_sample_size(stockplotr::example_data, comp_type = "length") +} +\references{ +McAllister, M.K., and Ianelli, J.N. (1997). Bayesian stock +assessment using catch-age data and the sampling-importance resampling +algorithm. Canadian Journal of Fisheries and Aquatic Sciences 54: 284-300. +} +\seealso{ +[prepare_comp_data()], [plot_comp_francis()] +} diff --git a/man/plot_comp_sex_ratio.Rd b/man/plot_comp_sex_ratio.Rd index 4f806fe0..65ca2579 100644 --- a/man/plot_comp_sex_ratio.Rd +++ b/man/plot_comp_sex_ratio.Rd @@ -16,7 +16,7 @@ plot_comp_sex_ratio( \arguments{ \item{dat}{A data frame of composition data in any format accepted by [prepare_comp_data()], such as FIMS output, an r4ss `lendbase`/`agedbase` -table, or a tidy data frame like [example_comp_data].} +table, or a tidy data frame like [bigskate_lencomp].} \item{aggregate}{Logical. TRUE/FALSE; aggregate compositions across years within each fleet. Years are weighted by their sample size when sample @@ -37,8 +37,9 @@ more than one. Options: "age", "length", or NULL (keep all). Default: NULL} -\item{fleet}{Character or numeric vector. Fleet(s) to keep. NULL keeps all -fleets. +\item{fleet}{Character or numeric vector. Fleet(s) to keep, matching +either the fleet name (e.g., "Fishery_current") or the fleet name with its +partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. Default: NULL} @@ -58,13 +59,21 @@ small proportions. \details{ Requires sex-specific compositions with both "female" and "male" values in the `sex` column of `dat`. Points show observed ratios -and lines show expected ratios. When `aggregate = TRUE`, female and male +and lines show expected ratios. As in r4ss, the smallest observed +proportion in each composition (such as the small constant Stock Synthesis +adds to every bin) is subtracted from the observed and expected values +first, so bins with no fish observed are omitted. When `aggregate = TRUE`, female and male compositions are summed across years (weighted by sample size when available) before calculating ratios. } +\section{r4ss equivalent}{ + `r4ss::SSplotSexRatio()` with +`sexratio.option = 2` (female:total). +} + \examples{ -plot_comp_sex_ratio(example_comp_data, fleet = "Survey") -plot_comp_sex_ratio(example_comp_data, aggregate = TRUE) +plot_comp_sex_ratio(bigskate_lencomp, fleet = "WCGBTS") +plot_comp_sex_ratio(bigskate_lencomp, aggregate = TRUE) } \seealso{ [prepare_comp_data()], [plot_comp()] diff --git a/man/prepare_comp_data.Rd b/man/prepare_comp_data.Rd index ce69888c..0941e908 100644 --- a/man/prepare_comp_data.Rd +++ b/man/prepare_comp_data.Rd @@ -4,15 +4,22 @@ \alias{prepare_comp_data} \title{Prepare composition data for plotting} \usage{ -prepare_comp_data(dat, comp_type = NULL, fleet = NULL, normalize = TRUE) +prepare_comp_data( + dat, + comp_type = NULL, + fleet = NULL, + normalize = TRUE, + conditional = FALSE +) } \arguments{ \item{dat}{A data frame of composition data. The following formats are recognized automatically: \describe{ \item{Tidy composition data}{Columns `year`, `bin`, and `observed`, with - optional columns `fleet`, `sex`, `expected`, `n` (input or adjusted - sample size), `pearson`, and `comp_type`. See [example_comp_data].} + optional columns `fleet`, `sex`, `part` (partition: 0 = whole catch, + 1 = discard, 2 = retained), `expected`, `n` (input or adjusted sample + size), `pearson`, and `comp_type`. See [bigskate_lencomp].} \item{FIMS output}{Output from FIMS (e.g., `FIMS::get_estimates()` or [convert_output()] with `model = "fims"`) that contains `observed` and `expected` columns. Rows whose `label` contains "comp" are kept and the @@ -28,36 +35,50 @@ recognized automatically: `lendbase` or `agedbase` elements (columns `Yr`, `Fleet`, `Sex`, `Bin`, `Obs`, `Exp`, `Pearson`, `Nsamp_adj`, ...). Conditional age-at-length rows are dropped from `agedbase` so that only marginal age - compositions remain.} -}} + compositions remain, unless `conditional = TRUE`.} +} +For conditional age-at-length data (`conditional = TRUE`), tidy data also +need a `length_bin` column giving the length bin that each age +composition is conditioned on (see [bigskate_caal]).} \item{comp_type}{String. Type of composition to keep when `dat` contains more than one. Options: "age", "length", or NULL (keep all). Default: NULL} -\item{fleet}{Character or numeric vector. Fleet(s) to keep. NULL keeps all -fleets. +\item{fleet}{Character or numeric vector. Fleet(s) to keep, matching +either the fleet name (e.g., "Fishery_current") or the fleet name with its +partition (e.g., "Fishery_current (retained)"). NULL keeps all fleets. Default: NULL} \item{normalize}{Logical. TRUE/FALSE; rescale observed and expected values so that they sum to one within each year, fleet, and composition type -(summing across sexes so that sex-specific compositions remain jointly -normalized). Use TRUE when `dat` contains counts rather than proportions. +(and length bin for conditional data). Sex-specific compositions are +normalized jointly across sexes, unless each sex already sums to one on +its own (single-sex compositions). Use TRUE when `dat` contains counts +rather than proportions. Default: TRUE} + +\item{conditional}{Logical. TRUE/FALSE; keep conditional age-at-length +data instead of marginal compositions. Conditional compositions are +normalized within each length bin. Used by [plot_comp_andre()] and +[plot_comp_bubble()]. + +Default: FALSE} } \value{ A tibble with one row per year, fleet, sex, and bin and columns `comp_type`, `fleet`, `year`, `sex`, `bin`, `observed`, `expected`, `n`, -and `pearson`. Columns that cannot be determined from `dat` are `NA`. +and `pearson` (plus `length_bin` when `conditional = TRUE`). Columns that +cannot be determined from `dat` are `NA`. } \description{ Reshape age or length composition data (observed and, optionally, expected proportions) into the tidy format used by the composition plotting functions ([plot_comp()], [plot_comp_bubble()], -[plot_comp_residuals()], [plot_comp_sex_ratio()], and [plot_comp_mean()]). +[plot_comp_residuals()], [plot_comp_sex_ratio()], and [plot_comp_francis()]). } \details{ When Pearson residuals are not supplied, they are calculated @@ -68,7 +89,7 @@ where \eqn{o} and \eqn{e} are the observed and expected proportions and residuals are left as `NA`. } \examples{ -comps <- prepare_comp_data(example_comp_data, fleet = "Survey") +comps <- prepare_comp_data(bigskate_lencomp, fleet = "WCGBTS") head(comps) # Data in the stockplotr long format are reshaped automatically @@ -83,5 +104,5 @@ prepare_comp_data(long) } \seealso{ [plot_comp()], [plot_comp_bubble()], [plot_comp_residuals()], -[plot_comp_sex_ratio()], [plot_comp_mean()] +[plot_comp_sex_ratio()], [plot_comp_francis()] } diff --git a/tests/testthat/test-plot_comp.R b/tests/testthat/test-plot_comp.R index 5e88cb3b..d8fed15f 100644 --- a/tests/testthat/test-plot_comp.R +++ b/tests/testthat/test-plot_comp.R @@ -8,17 +8,24 @@ has_layer <- function(p, geom_class) { # prepare_comp_data ---------------------------------------------------------- test_that("prepare_comp_data returns standard columns from tidy data", { - comps <- prepare_comp_data(stockplotr::example_comp_data) + comps <- prepare_comp_data(stockplotr::bigskate_lencomp) expect_s3_class(comps, "stockplotr_comp") expect_named( comps, c("comp_type", "fleet", "year", "sex", "bin", "observed", "expected", "n", "pearson") ) - # proportions sum to one across sexes within year and fleet + # proportions sum to one across sexes within year, fleet, and partition sums <- comps |> dplyr::summarise(total = sum(observed), .by = c(fleet, year)) - expect_true(all(abs(sums$total - 1) < 1e-8)) - # multinomial Pearson residuals are calculated + expect_true(all(abs(sums$total - 1) < 1e-6)) + # Stock Synthesis Pearson residuals are kept + expect_equal(sort(comps$pearson), sort(stockplotr::bigskate_lencomp$pearson)) +}) + +test_that("prepare_comp_data calculates multinomial Pearson residuals", { + comps <- prepare_comp_data( + dplyr::select(stockplotr::bigskate_lencomp, -pearson) + ) i <- 10 expect_equal( comps$pearson[i], @@ -28,18 +35,46 @@ test_that("prepare_comp_data returns standard columns from tidy data", { }) test_that("prepare_comp_data filters by fleet and comp_type", { - comps <- prepare_comp_data(stockplotr::example_comp_data, fleet = "Survey") - expect_equal(unique(comps$fleet), "Survey") + comps <- prepare_comp_data(stockplotr::bigskate_lencomp, fleet = "WCGBTS") + expect_equal(unique(comps$fleet), "WCGBTS") expect_error( - prepare_comp_data(stockplotr::example_comp_data, fleet = "not a fleet"), + prepare_comp_data(stockplotr::bigskate_lencomp, fleet = "not a fleet"), "No composition data" ) expect_error( - prepare_comp_data(stockplotr::example_comp_data, comp_type = "length"), + prepare_comp_data(stockplotr::bigskate_lencomp, comp_type = "age"), "No composition data" ) }) +test_that("partitions are added to fleet names as in r4ss", { + comps <- prepare_comp_data(stockplotr::bigskate_lencomp) + expect_setequal( + unique(comps$fleet), + c("Fishery_current (discard)", "Fishery_current (retained)", "WCGBTS", "Triennial") + ) + # a fleet can be selected with or without its partition + both <- prepare_comp_data(stockplotr::bigskate_lencomp, fleet = "Fishery_current") + expect_equal(length(unique(both$fleet)), 2) + retained <- prepare_comp_data(stockplotr::bigskate_lencomp, fleet = "Fishery_current (retained)") + expect_equal(unique(retained$fleet), "Fishery_current (retained)") +}) + +test_that("single-sex compositions are normalized separately", { + one_sex <- data.frame( + year = 2000, + sex = rep(c("female", "male"), each = 3), + bin = rep(1:3, 2), + observed = c(0.2, 0.3, 0.5, 0.1, 0.1, 0.8) + ) + comps <- prepare_comp_data(one_sex) + expect_equal(comps$observed, one_sex$observed) + # joint (two-sex) compositions are normalized together + joint <- one_sex + joint$observed <- joint$observed / 2 + expect_equal(prepare_comp_data(joint)$observed, joint$observed) +}) + test_that("prepare_comp_data normalizes counts", { counts <- data.frame(year = 2000, bin = 1:4, observed = c(10, 20, 30, 40)) comps <- prepare_comp_data(counts) @@ -96,19 +131,22 @@ test_that("prepare_comp_data reads r4ss output", { # plot_comp ------------------------------------------------------------------ test_that("plot_comp makes observation-only and fit plots", { - p_obs <- plot_comp(stockplotr::example_comp_data, fleet = "Survey", show_expected = FALSE) + p_obs <- plot_comp(stockplotr::bigskate_lencomp, fleet = "WCGBTS", show_expected = FALSE) expect_s3_class(p_obs, "ggplot") expect_true(has_layer(p_obs, "GeomCol")) expect_false(has_layer(p_obs, "GeomLine")) - p_fit <- plot_comp(stockplotr::example_comp_data, fleet = "Fishery") + p_fit <- plot_comp(stockplotr::bigskate_lencomp, fleet = "Triennial") expect_true(has_layer(p_fit, "GeomLine")) # males are mirrored below zero expect_true(any(p_fit$data$obs_plot < 0)) + # r4ss-style sample size labels + text_layer <- p_fit$layers[vapply(p_fit$layers, function(l) inherits(l$geom, "GeomText"), logical(1))][[1]] + expect_true(all(grepl("^N adj\\.=.*N eff\\.=", text_layer$data$label))) }) test_that("plot_comp aggregates across years", { - p <- plot_comp(stockplotr::example_comp_data, aggregate = TRUE) + p <- plot_comp(stockplotr::bigskate_lencomp, aggregate = TRUE) expect_s3_class(p, "ggplot") expect_false("year" %in% names(p$data)) sums <- p$data |> @@ -122,24 +160,24 @@ test_that("plot_comp works with r4ss output", { # plot_comp_bubble / plot_comp_residuals -------------------------------------- test_that("bubble plots show observations and residuals", { - p <- plot_comp_bubble(stockplotr::example_comp_data) + p <- plot_comp_bubble(stockplotr::bigskate_lencomp) expect_s3_class(p, "ggplot") expect_true(has_layer(p, "GeomPoint")) - r <- plot_comp_residuals(stockplotr::example_comp_data) + r <- plot_comp_residuals(stockplotr::bigskate_lencomp) expect_s3_class(r, "ggplot") expect_true(all(c("Observed > expected", "Observed < expected") %in% levels(r$data$sign))) expect_true(any(grepl("max =", r$data$panel))) }) test_that("residual plot errors without expected values or sample sizes", { - obs_only <- dplyr::select(stockplotr::example_comp_data, -expected, -n) + obs_only <- dplyr::select(stockplotr::bigskate_lencomp, -expected, -n, -pearson) expect_error(plot_comp_residuals(obs_only), "No Pearson residuals") }) # plot_comp_sex_ratio --------------------------------------------------------- test_that("plot_comp_sex_ratio calculates ratios and intervals", { - p <- plot_comp_sex_ratio(stockplotr::example_comp_data, fleet = "Survey") + p <- plot_comp_sex_ratio(stockplotr::bigskate_lencomp, fleet = "WCGBTS") expect_s3_class(p, "ggplot") expect_true(has_layer(p, "GeomLinerange")) ratios <- p$data @@ -148,16 +186,20 @@ test_that("plot_comp_sex_ratio calculates ratios and intervals", { expect_true(all(ratios$lower[ok] <= ratios$ratio_obs[ok] + 1e-12)) expect_true(all(ratios$upper[ok] >= ratios$ratio_obs[ok] - 1e-12)) - expect_no_error(plot_comp_sex_ratio(stockplotr::example_comp_data, aggregate = TRUE)) + # bins without fish (only the constant Stock Synthesis adds) are omitted + # rather than shown as 50:50 + expect_false(any(ratios$ratio_obs[ok] == 0.5 & ratios$bin[ok] > 180)) + + expect_no_error(plot_comp_sex_ratio(stockplotr::bigskate_lencomp, aggregate = TRUE)) }) test_that("plot_comp_sex_ratio requires two sexes", { - combined <- dplyr::filter(stockplotr::example_comp_data, sex == "female") + combined <- dplyr::filter(stockplotr::bigskate_lencomp, sex == "female") expect_error(plot_comp_sex_ratio(combined), "both") }) -# plot_comp_mean -------------------------------------------------------------- -test_that("plot_comp_mean matches r4ss Francis weights", { +# plot_comp_francis -------------------------------------------------------------- +test_that("plot_comp_francis matches r4ss Francis weights", { # Values from r4ss::SSMethod.TA1.8() for the simple_small model means <- comp_mean_table( prepare_comp_data(r4ss_output, comp_type = "length", fleet = "FISHERY") @@ -167,15 +209,25 @@ test_that("plot_comp_mean matches r4ss Francis weights", { prepare_comp_data(r4ss_output, comp_type = "age", fleet = "SURVEY1") ) expect_equal(1 / stats::var(means$std_resid), 2.667424, tolerance = 1e-6) + # Big Skate: partitions of a fleet are combined, as in r4ss + means <- comp_mean_table( + prepare_comp_data(stockplotr::bigskate_lencomp, fleet = "Fishery_current") + ) + expect_equal(1 / stats::var(means$std_resid), 1.0019480, tolerance = 1e-6) + expect_equal(unique(means$fleet), "Fishery_current (discard & retained)") + means <- comp_mean_table( + prepare_comp_data(stockplotr::bigskate_lencomp, fleet = "WCGBTS") + ) + expect_equal(1 / stats::var(means$std_resid), 1.0000112, tolerance = 1e-6) }) -test_that("plot_comp_mean plots observed and expected means", { - p <- plot_comp_mean(stockplotr::example_comp_data) +test_that("plot_comp_francis plots observed and expected means", { + p <- plot_comp_francis(stockplotr::bigskate_lencomp) expect_s3_class(p, "ggplot") expect_true(has_layer(p, "GeomLine")) expect_true(has_layer(p, "GeomErrorbar")) - expect_true(any(grepl("Francis weight", p$data$fleet))) + expect_true(all(grepl("TA1.8 weight", p$data$fleet))) - no_francis <- plot_comp_mean(stockplotr::example_comp_data, show_francis = FALSE) + no_francis <- plot_comp_francis(stockplotr::bigskate_lencomp, show_francis = FALSE) expect_false(has_layer(no_francis, "GeomErrorbar")) }) diff --git a/tests/testthat/test-plot_comp_diagnostics.R b/tests/testthat/test-plot_comp_diagnostics.R new file mode 100644 index 00000000..f0429789 --- /dev/null +++ b/tests/testthat/test-plot_comp_diagnostics.R @@ -0,0 +1,182 @@ +r4ss_output <- readRDS( + test_path("fixtures", "r4ss_output", "simple_small", "simple_r4ss.rds") +) + +has_layer <- function(p, geom_class) { + any(vapply(p$layers, function(l) inherits(l$geom, geom_class), logical(1))) +} + +# plot_comp_sample_size ------------------------------------------------------- +test_that("effective sample sizes match Stock Synthesis", { + comps <- prepare_comp_data(r4ss_output, comp_type = "length") + effn <- comp_effn_table(comps) + ss3 <- r4ss_output$lendbase |> + dplyr::distinct(Yr, Fleet, effN) |> + dplyr::mutate(fleet = r4ss_output$FleetNames[Fleet]) + joined <- dplyr::inner_join(effn, ss3, by = c("year" = "Yr", "fleet")) + expect_gt(nrow(joined), 0) + expect_equal(joined$effn, joined$effN, tolerance = 1e-3) +}) + +test_that("plot_comp_sample_size works with composition data", { + p <- plot_comp_sample_size(stockplotr::bigskate_lencomp) + expect_s3_class(p, "ggplot") + expect_true(has_layer(p, "GeomAbline")) + expect_true(all(grepl("McAllister-Ianelli weight", p$data$panel))) + # Matches Stock Synthesis: Recommend_var_adj = Curr_Var_Adj * weight, with + # partitions of a fleet combined (Length_Comp_Fit_Summary for Big Skate) + weights <- dplyr::distinct(p$data, base_fleet, mi_weight) + ss3 <- data.frame( + base_fleet = c("Fishery_current", "WCGBTS", "Triennial"), + curr_var_adj = c(0.239885, 0.067420, 1), + recommend_var_adj = c(0.107271, 0.637793, 0.870899) + ) + joined <- dplyr::inner_join(weights, ss3, by = "base_fleet") + expect_equal(nrow(joined), 3) + # (tolerance allows for the precision of values printed by Stock Synthesis) + expect_equal(joined$mi_weight * joined$curr_var_adj, joined$recommend_var_adj, tolerance = 1e-3) + expect_no_error(plot_comp_sample_size(r4ss_output, comp_type = "age", show_years = TRUE)) +}) + +test_that("plot_comp_sample_size works with converted SS3 output", { + p <- plot_comp_sample_size(stockplotr::example_data, comp_type = "length") + expect_s3_class(p, "ggplot") + expect_true(all(p$data$comp_type == "length")) + # retained and discard compositions are separate panels + expect_true(any(grepl("retained", p$data$fleet))) + expect_true(any(grepl("discard", p$data$fleet))) + # conditional age-at-length comps are dropped from age comps + expect_message( + plot_comp_sample_size(stockplotr::example_data, comp_type = "age"), + "conditional age-at-length" + ) +}) + +test_that("plot_comp_sample_size errors without expected values", { + obs_only <- dplyr::select(stockplotr::bigskate_lencomp, -expected) + expect_error(plot_comp_sample_size(obs_only), "could not be calculated") +}) + +# residual distribution and patterns ----------------------------------------- +test_that("plot_comp_residual_dist makes qq plots and histograms", { + qq <- plot_comp_residual_dist(stockplotr::bigskate_lencomp) + expect_s3_class(qq, "ggplot") + expect_true(has_layer(qq, "GeomPoint")) + expect_true(all(grepl("SDNR", qq$data$panel))) + + hist <- plot_comp_residual_dist(stockplotr::bigskate_lencomp, type = "histogram") + expect_true(has_layer(hist, "GeomBar")) +}) + +test_that("plot_comp_residual_pattern summarizes by bin and year", { + p_bin <- plot_comp_residual_pattern(stockplotr::bigskate_lencomp) + expect_s3_class(p_bin, "ggplot") + expect_true("bin" %in% names(p_bin$data)) + # mean residual by bin matches a direct calculation + direct <- stockplotr::bigskate_lencomp |> + dplyr::filter(fleet == "WCGBTS", sex == "female", bin == 50) + check <- dplyr::filter(p_bin$data, fleet == "WCGBTS", sex == "female", bin == 50) + expect_equal(check$mean_resid, mean(direct$pearson)) + + p_year <- plot_comp_residual_pattern(stockplotr::bigskate_lencomp, by = "year") + expect_true("year" %in% names(p_year$data)) +}) + +test_that("residual plots error without residuals", { + obs_only <- dplyr::select(stockplotr::bigskate_lencomp, -expected, -n, -pearson) + expect_error(plot_comp_residual_dist(obs_only), "No Pearson residuals") + expect_error(plot_comp_residual_pattern(obs_only), "No Pearson residuals") +}) + +test_that("runs_test detects patterns", { + expect_lt(runs_test(c(rep(1, 10), rep(-1, 10))), 0.05) + expect_gt(runs_test(rep(c(1, -1), 10)), 0.5) + expect_equal(runs_test(rep(-1, 8)), 2 * 0.5^8) + expect_true(is.na(runs_test(c(1, -1)))) +}) + +# conditional age-at-length -------------------------------------------------- +test_that("prepare_comp_data handles conditional age-at-length data", { + caal <- prepare_comp_data(stockplotr::bigskate_caal, conditional = TRUE) + expect_true("length_bin" %in% names(caal)) + # single-sex compositions stay normalized within each sex and length bin + sums <- caal |> + dplyr::summarise(total = sum(observed), .by = c(fleet, year, sex, length_bin)) + expect_true(all(abs(sums$total - 1) < 1e-6)) + expect_equal(caal$observed, stockplotr::bigskate_caal$observed[ + order(stockplotr::bigskate_caal$fleet, stockplotr::bigskate_caal$year, + stockplotr::bigskate_caal$length_bin, stockplotr::bigskate_caal$sex, + stockplotr::bigskate_caal$bin) + ], tolerance = 1e-6) + # marginal plots refuse conditional data + expect_error(prepare_comp_data(stockplotr::bigskate_caal), "conditional = TRUE") + expect_error(plot_comp(stockplotr::bigskate_caal), "conditional = TRUE") + # and conditional plots need a length bin + expect_error( + prepare_comp_data(stockplotr::bigskate_lencomp, conditional = TRUE), + "length_bin" + ) +}) + +test_that("prepare_comp_data reads conditional data from r4ss dbase", { + dbase <- r4ss_output$agedbase + # make half of the age comps conditional on a narrow length bin + dbase$Lbin_hi[seq_len(nrow(dbase) / 2)] <- dbase$Lbin_lo[seq_len(nrow(dbase) / 2)] + caal <- prepare_comp_data(dbase, conditional = TRUE) + expect_equal(nrow(caal), nrow(dbase) / 2) + marginal <- suppressMessages(prepare_comp_data(dbase)) + expect_equal(nrow(marginal), nrow(dbase) / 2) + # r4ss output without conditional data + expect_error(prepare_comp_data(r4ss_output, conditional = TRUE), "No conditional") +}) + +test_that("plot_comp_andre shows mean and SE of age at length", { + dat <- dplyr::filter(stockplotr::bigskate_caal, year %in% 2017:2018) + p <- plot_comp_andre(dat, fleet = "WCGBTS") + expect_s3_class(p, "ggplot") + expect_setequal(as.character(unique(p$data$statistic)), c("Mean age", "SE of mean age")) + expect_true(has_layer(p, "GeomRibbon")) + # observed mean ages increase with length + means <- dplyr::filter(p$data, statistic == "Mean age", year == 2018, sex == "female") + expect_gt(stats::cor(means$length_bin, means$observed), 0.8) + # one value per year, sex, and length bin, calculated as in r4ss + z <- dplyr::filter( + stockplotr::bigskate_caal, + fleet == "WCGBTS", year == 2018, sex == "female", length_bin == 60 + ) + check <- dplyr::filter(p$data, year == 2018, sex == "female", length_bin == 60) + obs_mean <- sum(z$bin * z$observed) / sum(z$observed) + expect_equal(check$observed[check$statistic == "Mean age"], obs_mean) + expect_equal( + check$expected[check$statistic == "SE of mean age"], + sqrt(sum(z$bin^2 * z$expected) / sum(z$expected) - + (sum(z$bin * z$expected) / sum(z$expected))^2) / sqrt(z$n[1]) + ) +}) + +test_that("conditional bubble plots use length bins on the x-axis", { + dat <- dplyr::filter(stockplotr::bigskate_caal, year %in% 2017:2018) + p <- plot_comp_residuals(dat, fleet = "WCGBTS", conditional = TRUE) + expect_s3_class(p, "ggplot") + expect_true(any(grepl("^female, 2017\n\\(max", levels(p$data$panel)))) + expect_no_error(plot_comp_bubble(dat, fleet = "WCGBTS", conditional = TRUE)) +}) + +test_that("r4ss sex codes are read correctly", { + # single-sex male compositions have the Stock Synthesis code Sex = 1 but + # r4ss sex = 2, and appear twice in the composition database + dbase <- data.frame( + Yr = 2000, Fleet = 1, Kind = "AGE", Part = 0, + Sexes = 2, Sex = c(1, 1, 2, 2), sex = 2, + Lbin_lo = 50, Lbin_hi = 50, Bin = c(1, 2, 1, 2), + Obs = c(0.4, 0.6, 0.4, 0.6), Exp = c(0.5, 0.5, 0.5, 0.5), + Pearson = c(-0.2, 0.2, -0.2, 0.2), Nsamp_adj = 10 + ) + comps <- prepare_comp_data(dbase, conditional = TRUE) + expect_equal(nrow(comps), 2) + expect_equal(unique(comps$sex), "male") + expect_equal(comps$observed, c(0.4, 0.6)) + # without the r4ss sex column, sex is derived from Sexes and Sex + comps <- prepare_comp_data(dplyr::select(dbase, -sex), conditional = TRUE) + expect_equal(unique(comps$sex), "male") +}) diff --git a/vignettes/composition_diagnostics.Rmd b/vignettes/composition_diagnostics.Rmd index 41f54757..f95bfd7f 100644 --- a/vignettes/composition_diagnostics.Rmd +++ b/vignettes/composition_diagnostics.Rmd @@ -27,19 +27,24 @@ Age and length compositions are often the most informative, and the hardest to fit, data in a stock assessment. {stockplotr} has a set of plots for composition data based on the figures that [r4ss](https://github.com/r4ss/r4ss) makes for Stock Synthesis models. Each -type of plot shows the data in a different way: - -| Plot | Function | What it shows | -|------|----------|---------------| -| Distributions of observations | `plot_comp(show_expected = FALSE)` | The most intuitive way to look at compositions | -| Bubble plot of observations | `plot_comp_bubble()` | Cohort strength over time | -| Distributions of observed and expected values | `plot_comp()` | An intuitive way to look at fit | -| Pearson residuals | `plot_comp_residuals()` | Blocks or stripes of misfit among years or bins | -| Sex ratios | `plot_comp_sex_ratio()` | Trends in misfit for bins with small proportions, which have small residuals | -| Mean age or length | `plot_comp_mean()` | Trends among years; Francis (2011) data weights | - -Each function can plot each fleet separately or summarize all fleets. Use -`fleet` to choose fleets, and `aggregate = TRUE` in `plot_comp()` and +plot shows the data in a different way, and each has an r4ss equivalent: + +| Plot | Function | What it shows | r4ss equivalent | +|------|----------|---------------|-----------------| +| Distributions of observations | `plot_comp(show_expected = FALSE)` | The most intuitive way to look at compositions | `SSplotComps()` subplot 1, `datonly = TRUE` | +| Bubble plot of observations | `plot_comp_bubble()` | Cohort strength over time | `SSplotComps()` subplot 2, `datonly = TRUE` | +| Distributions of observed and expected values | `plot_comp()` | An intuitive way to look at fit | `SSplotComps()` subplots 1 and 21 | +| Pearson residuals | `plot_comp_residuals()` | Blocks or stripes of misfit among years or bins | `SSplotComps()` subplots 2 and 24 | +| Sex ratios | `plot_comp_sex_ratio()` | Trends in misfit for bins with small proportions, which have small residuals | `SSplotSexRatio()` | +| Mean age or length (Francis) | `plot_comp_francis()` | Trends among years; Francis (2011) TA1.8 data weights | `SSplotComps()` subplots 8 and 9, `SSMethod.TA1.8()` | +| N-EffN comparison | `plot_comp_sample_size()` | McAllister-Ianelli data weights | `SSplotComps()` subplot 7 | +| Residual distribution | `plot_comp_residual_dist()` | Heavy tails, skewness, and outliers; SDNR | | +| Residual patterns | `plot_comp_residual_pattern()` | Bias by bin or year, with a runs test | | +| Andre's plots | `plot_comp_andre()` | Mean age at length for conditional age-at-length data | `SSplotComps()` subplot 12 | +| Conditional age-at-length residuals | `plot_comp_residuals(conditional = TRUE)` | Misfit by length and age within years | `SSplotComps()` subplot 3 | + +Each function can plot fleets separately or summarize all fleets. Use `fleet` +to choose fleets, and `aggregate = TRUE` in `plot_comp()` and `plot_comp_sex_ratio()` to combine all years. ## Composition data @@ -48,100 +53,176 @@ The plotting functions take composition data in one of several formats and standardize it with `prepare_comp_data()`: * A tidy data frame with columns `year`, `bin`, and `observed`, and, - optionally, `fleet`, `sex`, `expected`, `n` (sample size), `pearson`, and - `comp_type` ("age" or "length"). + optionally, `fleet`, `sex`, `part` (partition), `expected`, `n` (sample + size), `pearson`, and `comp_type` ("age" or "length"). * FIMS output with `observed` and `expected` columns, such as the output of `FIMS::get_estimates()`. * {stockplotr} standard output from `convert_output()` with labels such as `age_composition_proportion` and `age_composition_expected`. -* Output from `r4ss::SS_output()`, either the whole list or its `lendbase` or - `agedbase` data frames. +* Output from `r4ss::SS_output()`, either the whole list or its `lendbase`, + `agedbase`, or `condbase` data frames. -This vignette uses `example_comp_data`, which holds simulated sex-specific age -compositions for a fishery and a survey. The observed fishery data were -simulated with dome-shaped selectivity, but the expected values assume -asymptotic selectivity. The diagnostics below should show that misfit. +This vignette uses data from the 2019 Big Skate stock assessment for the U.S. +West Coast, the same model used for the +[r4ss example plots](https://r4ss.github.io/r4ss/BigSkate/), so the figures +below can be compared directly with the r4ss versions. `bigskate_lencomp` +holds the length compositions (`lendbase` from `r4ss::SS_output()`) and +`bigskate_caal` the conditional age-at-length data (`condbase`), with columns +renamed to stockplotr's conventions. ```{r} -head(example_comp_data) +head(bigskate_lencomp) ``` +The length compositions are sex-specific. `Fishery_current` has separate +retained (`part` = 2) and discarded (`part` = 1) compositions, which are +labeled "Fishery_current (retained)" and "Fishery_current (discard)", as in +r4ss. Use `fleet = "Fishery_current"` to select both. + If Pearson residuals are not supplied, `prepare_comp_data()` calculates them assuming a multinomial distribution, -$r = (o - e) / \sqrt{e (1 - e) / N}$, using the sample size `n`. +$r = (o - e) / \sqrt{e (1 - e) / N}$, using the sample size `n`. The Big +Skate data include the residuals reported by Stock Synthesis. ## Observations Distributions are the most intuitive way to look at compositions. For sex-specific data, females are shown above zero and males below. -```{r obs-dist} -plot_comp(example_comp_data, fleet = "Survey", show_expected = FALSE) +```{r obs-dist, fig.height = 9} +plot_comp(bigskate_lencomp, fleet = "WCGBTS", show_expected = FALSE) ``` -Bubble plots make it easier to see strong and weak year classes moving -through the population as diagonal lines. +Bubble plots make it easier to see patterns across years, such as strong +cohorts moving through the population. ```{r obs-bubble} -plot_comp_bubble(example_comp_data) +plot_comp_bubble(bigskate_lencomp) ``` ## Fits to the data Adding the expected values to the distribution plot shows the fit to each -year. +year. As in r4ss, each panel shows the adjusted input sample size (N adj.) +and the effective sample size (N eff.). -```{r fit-dist} -plot_comp(example_comp_data, fleet = "Fishery") +```{r fit-dist, fig.height = 4} +plot_comp(bigskate_lencomp, fleet = "Triennial") ``` Aggregating across years gives an overview of each fleet. Years are weighted -by their sample sizes. +by their adjusted input sample sizes. -```{r fit-agg, fig.height = 4} -plot_comp(example_comp_data, aggregate = TRUE) +```{r fit-agg, fig.height = 6} +plot_comp(bigskate_lencomp, aggregate = TRUE) ``` ### Pearson residuals Pearson residuals are a more statistically rigorous way to look at fit. Filled bubbles show where more fish were observed than expected, and open -bubbles where fewer were observed. Here, the fishery has consistently -negative residuals at older ages, which is the pattern caused by the -mis-specified selectivity. +bubbles where fewer were observed. The largest residual in each panel is +included in the label. -```{r resid} -plot_comp_residuals(example_comp_data) +```{r resid, fig.height = 8} +plot_comp_residuals(bigskate_lencomp) ``` ### Sex ratios -The proportion female in each bin, female / (female + male), can show -trends in misfit for bins with small proportions, since those bins have small +The fraction female in each bin, female / (female + male), can show trends +in misfit for bins with small proportions, since those bins have small residuals. Vertical lines are Jeffreys intervals based on the sample size in -each bin. +each bin. For Big Skate, the largest fish are almost all female. -```{r sex-ratio} -plot_comp_sex_ratio(example_comp_data, fleet = "Survey") +```{r sex-ratio, fig.height = 9} +plot_comp_sex_ratio(bigskate_lencomp, fleet = "WCGBTS") ``` -```{r sex-ratio-agg, fig.height = 4} -plot_comp_sex_ratio(example_comp_data, aggregate = TRUE) +```{r sex-ratio-agg, fig.height = 6} +plot_comp_sex_ratio(bigskate_lencomp, aggregate = TRUE) ``` -### Mean age or length +### Mean length and Francis weights The time series of mean age or length was developed as a diagnostic for the -Francis (2011) data weighting method, but it is also a useful summary of -trends in the data and the fit. Thick intervals are based on the input sample -sizes and thin, capped intervals on the sample sizes after applying the -Francis weight shown in each panel label. A weight well below one, as for the -fishery here, means the input sample sizes are too large relative to how well -the model can fit the mean of the compositions. - -```{r mean, fig.height = 4} +Francis (2011) data weighting method (TA1.8), but it is also a useful summary +of trends in the data and the fit. Thick intervals are based on the current +sample sizes, and thin, capped intervals show the result of further adjusting +sample sizes by the TA1.8 weight in each panel label. As in +`r4ss::SSMethod.TA1.8()`, partitions of a fleet are combined into one +composition per year. The weights near one show that this model was already +tuned with the Francis method. + +```{r francis, fig.height = 5} set.seed(1) # the interval for the Francis weight is bootstrapped -plot_comp_mean(example_comp_data) +plot_comp_francis(bigskate_lencomp) +``` + +### N-EffN comparison + +The effective sample size measures how well the model fits each composition +(McAllister and Ianelli 1997). If the input sample sizes suit the fit, the +points should scatter around the 1:1 line. The ratio of the harmonic mean +effective sample size to the mean input sample size, shown in each panel +label, is the McAllister-Ianelli weight. As in Stock Synthesis, it is +calculated across all partitions of a fleet, and multiplying it by the +current variance adjustment gives the `Recommend_var_adj` that Stock +Synthesis reports. + +```{r sample-size, fig.height = 6} +plot_comp_sample_size(bigskate_lencomp) +``` + +For Stock Synthesis models, the same plot can be made directly from +`convert_output()` output, using the adjusted input and effective sample +sizes that Stock Synthesis reports: + +```{r sample-size-ss3} +plot_comp_sample_size(stockplotr::example_data, comp_type = "length") +``` + +### Residual distribution and patterns + +A quantile-quantile plot shows whether residuals have heavier tails than +expected. The standard deviation of the normalized residuals (SDNR) is shown +in each panel label; values well above one suggest the data are given more +weight than the fit supports. + +```{r resid-qq, fig.height = 6} +plot_comp_residual_dist(bigskate_lencomp) +``` + +Averaging residuals by bin or year turns stripes in the bubble plot into a +single line. Filled points fail a runs test, meaning the residual signs in +that bin are not randomly ordered across years. + +```{r resid-pattern, fig.height = 8} +plot_comp_residual_pattern(bigskate_lencomp) +``` + +## Conditional age-at-length data + +Conditional age-at-length data are age compositions for each length bin. +Use `conditional = TRUE` in `prepare_comp_data()` and `plot_comp_bubble()`, +and supply a `length_bin` column in tidy data, as in `bigskate_caal`. The Big +Skate conditional data are single-sex compositions, which are normalized +separately for each sex. + +`plot_comp_andre()` makes "Andre's plots" from r4ss: the observed and +expected mean age in each length bin (left), and the standard error of the +mean age (right), one row per year and sex. + +```{r caal-andre, fig.height = 10} +caal_recent <- dplyr::filter(bigskate_caal, year %in% 2016:2018) +plot_comp_andre(caal_recent, fleet = "WCGBTS") +``` + +Pearson residuals for conditional data are plotted by length bin and age for +each year: + +```{r caal-resid, fig.height = 6} +plot_comp_residuals(caal_recent, fleet = "WCGBTS", conditional = TRUE) ``` ## Using model output @@ -151,23 +232,25 @@ With FIMS, pass the estimates directly: ```{r fims, eval = FALSE} estimates <- FIMS::get_estimates(fit) plot_comp_residuals(estimates, comp_type = "age") -plot_comp_mean(estimates, comp_type = "length") +plot_comp_francis(estimates, comp_type = "length") ``` FIMS reports years as indices (`year_i`); add a `year` column to plot calendar years. FIMS estimates do not currently include composition sample -sizes. Add an -`n` column, or supply Pearson residuals in a `pearson` column, to get -residuals and intervals. +sizes. Add an `n` column, or supply Pearson residuals in a `pearson` column, +to get residuals and intervals. With Stock Synthesis, use the output of `r4ss::SS_output()`. Pearson residuals -and adjusted sample sizes are taken from the model output, and the Francis -weights match `r4ss::SSMethod.TA1.8()`: +and adjusted sample sizes are taken from the model output, the Francis +weights match `r4ss::SSMethod.TA1.8()`, and the effective sample sizes and +McAllister-Ianelli weights match those reported by Stock Synthesis. +Conditional age-at-length data come from the `condbase` element: ```{r ss3, eval = FALSE} -replist <- r4ss::SS_output("path/to/model") -plot_comp(replist, comp_type = "length", fleet = "FISHERY") -plot_comp_residuals(replist, comp_type = "age") +replist <- r4ss::SS_output("path/to/BigSkate_2019") +plot_comp(replist, comp_type = "length", fleet = "WCGBTS") +plot_comp_francis(replist, comp_type = "length") +plot_comp_andre(replist, fleet = "WCGBTS") ``` ## References @@ -175,3 +258,11 @@ plot_comp_residuals(replist, comp_type = "age") Francis, R.I.C.C. (2011). Data weighting in statistical fisheries stock assessment models. Canadian Journal of Fisheries and Aquatic Sciences 68: 1124-1138. + +McAllister, M.K., and Ianelli, J.N. (1997). Bayesian stock assessment using +catch-age data and the sampling-importance resampling algorithm. Canadian +Journal of Fisheries and Aquatic Sciences 54: 284-300. + +Taylor, I.G., Gertseva, V., Stephens, A., and Bizzarro, J. (2019). Status of +Big Skate (*Beringraja binoculata*) off the U.S. Pacific Coast in 2019. +Pacific Fishery Management Council, Portland, OR. From 67e1152ac1aa48b76108a326e37d83919de29939 Mon Sep 17 00:00:00 2001 From: ericward-noaa Date: Sun, 18 Oct 2026 10:47:35 -0700 Subject: [PATCH 4/4] spelling forgot to run spell_check_package() added a few missing words --- R/data.R | 8 +-- R/plot_comp_diagnostics.R | 4 +- inst/WORDLIST | 89 +++++++++++++++++---------- man/bigskate_caal.Rd | 2 +- man/bigskate_lencomp.Rd | 6 +- man/plot_comp_andre.Rd | 4 +- vignettes/composition_diagnostics.Rmd | 2 +- 7 files changed, 70 insertions(+), 45 deletions(-) diff --git a/R/data.R b/R/data.R index 60474fcf..f3c4bef4 100644 --- a/R/data.R +++ b/R/data.R @@ -47,9 +47,9 @@ #' Length compositions and fits from the 2019 Big Skate stock assessment for #' the U.S. West Coast (`BigSkate_2019` in the Stock Synthesis test models), #' the model used for the r4ss example plots at -#' . The data are the `lendbase` -#' element of `r4ss::SS_output()` with columns renamed to stockplotr's -#' conventions. See `data-raw/bigskate_comps.R`. +#' \url{https://r4ss.github.io/r4ss/BigSkate/}. The data are the `lendbase` +#' element of `r4ss::SS_output()` with columns renamed to follow +#' stockplotr conventions. See `data-raw/bigskate_comps.R`. #' #' Compositions are sex-specific, with female and male proportions summing to #' one within each year, fleet, and partition. `Fishery_current` has separate @@ -79,7 +79,7 @@ #' #' Conditional age-at-length data and fits from the 2019 Big Skate stock #' assessment (see [bigskate_lencomp]). The data are the `condbase` element -#' of `r4ss::SS_output()` with columns renamed to stockplotr's conventions. +#' of `r4ss::SS_output()` with columns renamed to follow stockplotr conventions. #' Each age composition is for one sex and one length bin, and sums to one. #' See `data-raw/bigskate_comps.R`. #' diff --git a/R/plot_comp_diagnostics.R b/R/plot_comp_diagnostics.R index b1c74c57..6d96e008 100644 --- a/R/plot_comp_diagnostics.R +++ b/R/plot_comp_diagnostics.R @@ -360,8 +360,8 @@ plot_comp_residual_pattern <- function( #' Length bins with no observations or no sample size are omitted. Plot one #' fleet at a time with `fleet`, and subset years by filtering `dat`. #' -#' @section r4ss equivalent: `r4ss::SSplotComps()` subplot 12 ("Andre's mean age -#' and std. dev. in conditional AAL"). +#' @section r4ss equivalent: `r4ss::SSplotComps()` subplot 12 (Andre's plots of +#' mean age and standard deviation for conditional age-at-length data). #' #' @seealso [prepare_comp_data()], [plot_comp_bubble()] #' @export diff --git a/inst/WORDLIST b/inst/WORDLIST index f98d9134..62494c59 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,44 +1,25 @@ -agedbase -BAM -BMSY -Birthseason -CPUE -FIMS -FLIMIT -FMSY -FTARGET -Fmort -Hennen -Jeffreys -lendbase -Lifecycle -mis -MSY -Modelling -NOAA -Nsamp -ORCID -pearson -Petrale -Pre -Preformatted -Rceattle -Rda -Rmarkdown -Rmd -Spawners -SSMethod -StockSmart -Subseason aa +agedbase alttext +andre asar assmt +BAM bam +Beringraja +BigSkate +bigskate +binoculata birthseas +Birthseason +Bizzarro +BMSY +caal cha cmd +condbase conjuction +CPUE csv customizations cv @@ -46,41 +27,83 @@ dat dataframe's diagonostic dplyr +EffN +effn facetting +FIMS fims flextable +FLIMIT +Fmort +FMSY +francis +FTARGET +Gertseva getwd ggplot gp +Hennen hline href +Ianelli is’ +Jeffreys kableExtra kobe kqs +Lbin len +lencomp +lendbase +Lifecycle +loess +McAllister +mis +Modelling +MSY msy natively +NOAA noaa +Nsamp +nsamp nsim obsvpred +ORCID +pearson +Petrale pkgdown +Pre +Preformatted preformatted +qq +Rceattle rceattle +Rda rda rda's rdat +Rmarkdown +Rmd rowid satf sd +SDNR se seealso +sexratio socio +Spawners ss +SSMethod sso +SSplotComps +SSplotSexRatio stddev +StockSmart str stringr +Subseason subseason theming tibble @@ -89,5 +112,7 @@ tibbles tidyr tidyselect unfished +WCGBTS +Wolfowitz yaml yml diff --git a/man/bigskate_caal.Rd b/man/bigskate_caal.Rd index efc1ef1c..a7549b5a 100644 --- a/man/bigskate_caal.Rd +++ b/man/bigskate_caal.Rd @@ -32,7 +32,7 @@ bigskate_caal \description{ Conditional age-at-length data and fits from the 2019 Big Skate stock assessment (see [bigskate_lencomp]). The data are the `condbase` element -of `r4ss::SS_output()` with columns renamed to stockplotr's conventions. +of `r4ss::SS_output()` with columns renamed to follow stockplotr conventions. Each age composition is for one sex and one length bin, and sums to one. See `data-raw/bigskate_comps.R`. } diff --git a/man/bigskate_lencomp.Rd b/man/bigskate_lencomp.Rd index 78adb158..9450782a 100644 --- a/man/bigskate_lencomp.Rd +++ b/man/bigskate_lencomp.Rd @@ -32,9 +32,9 @@ bigskate_lencomp Length compositions and fits from the 2019 Big Skate stock assessment for the U.S. West Coast (`BigSkate_2019` in the Stock Synthesis test models), the model used for the r4ss example plots at -. The data are the `lendbase` -element of `r4ss::SS_output()` with columns renamed to stockplotr's -conventions. See `data-raw/bigskate_comps.R`. +\url{https://r4ss.github.io/r4ss/BigSkate/}. The data are the `lendbase` +element of `r4ss::SS_output()` with columns renamed to follow +stockplotr conventions. See `data-raw/bigskate_comps.R`. } \details{ Compositions are sex-specific, with female and male proportions summing to diff --git a/man/plot_comp_andre.Rd b/man/plot_comp_andre.Rd index 030582d2..87daf96b 100644 --- a/man/plot_comp_andre.Rd +++ b/man/plot_comp_andre.Rd @@ -52,8 +52,8 @@ Length bins with no observations or no sample size are omitted. Plot one fleet at a time with `fleet`, and subset years by filtering `dat`. } \section{r4ss equivalent}{ - `r4ss::SSplotComps()` subplot 12 ("Andre's mean age -and std. dev. in conditional AAL"). + `r4ss::SSplotComps()` subplot 12 (Andre's plots of +mean age and standard deviation for conditional age-at-length data). } \examples{ diff --git a/vignettes/composition_diagnostics.Rmd b/vignettes/composition_diagnostics.Rmd index f95bfd7f..bed02976 100644 --- a/vignettes/composition_diagnostics.Rmd +++ b/vignettes/composition_diagnostics.Rmd @@ -68,7 +68,7 @@ West Coast, the same model used for the below can be compared directly with the r4ss versions. `bigskate_lencomp` holds the length compositions (`lendbase` from `r4ss::SS_output()`) and `bigskate_caal` the conditional age-at-length data (`condbase`), with columns -renamed to stockplotr's conventions. +renamed to follow stockplotr conventions. ```{r} head(bigskate_lencomp)