From 774ee0f2fe38e7f6023f60a686b38ec7dc31722f Mon Sep 17 00:00:00 2001 From: Neal Richardson Date: Wed, 29 May 2024 11:37:23 -0400 Subject: [PATCH] GH-41834: [R] Better error handling in dplyr code (#41576) * GitHub Issue: #41834 --- r/R/dplyr-across.R | 6 +- r/R/dplyr-arrange.R | 87 +++--- r/R/dplyr-datetime-helpers.R | 31 +-- r/R/dplyr-eval.R | 182 ++++++++++--- r/R/dplyr-filter.R | 64 ++--- r/R/dplyr-funcs-agg.R | 6 +- r/R/dplyr-funcs-conditional.R | 16 +- r/R/dplyr-funcs-datetime.R | 18 +- r/R/dplyr-funcs-simple.R | 2 +- r/R/dplyr-funcs-string.R | 76 +++--- r/R/dplyr-funcs-type.R | 7 +- r/R/dplyr-mutate.R | 190 +++++++------ r/R/dplyr-slice.R | 2 +- r/R/dplyr-summarize.R | 70 ++--- r/R/dplyr.R | 16 -- r/man/arrow_not_supported.Rd | 56 ++++ r/tests/testthat/_snaps/dataset-dplyr.md | 9 + r/tests/testthat/_snaps/dplyr-across.md | 11 + r/tests/testthat/_snaps/dplyr-eval.md | 27 ++ .../testthat/_snaps/dplyr-funcs-datetime.md | 11 + r/tests/testthat/_snaps/dplyr-mutate.md | 25 ++ r/tests/testthat/_snaps/dplyr-query.md | 4 +- r/tests/testthat/_snaps/dplyr-summarize.md | 41 ++- r/tests/testthat/helper-expectation.R | 7 +- r/tests/testthat/test-dataset-dplyr.R | 5 +- r/tests/testthat/test-dplyr-across.R | 12 +- r/tests/testthat/test-dplyr-collapse.R | 13 - r/tests/testthat/test-dplyr-eval.R | 60 +++++ r/tests/testthat/test-dplyr-filter.R | 20 +- .../testthat/test-dplyr-funcs-conditional.R | 107 +++----- r/tests/testthat/test-dplyr-funcs-datetime.R | 46 +--- r/tests/testthat/test-dplyr-funcs-string.R | 79 +++--- r/tests/testthat/test-dplyr-mutate.R | 13 +- r/tests/testthat/test-dplyr-summarize.R | 55 +--- .../developers/matchsubstringoptions.png | Bin 89899 -> 0 bytes r/vignettes/developers/starts_with_docs.png | Bin 9720 -> 0 bytes r/vignettes/developers/startswithdocs.png | Bin 42409 -> 0 bytes r/vignettes/developers/writing_bindings.Rmd | 253 ------------------ 38 files changed, 804 insertions(+), 823 deletions(-) create mode 100644 r/man/arrow_not_supported.Rd create mode 100644 r/tests/testthat/_snaps/dataset-dplyr.md create mode 100644 r/tests/testthat/_snaps/dplyr-across.md create mode 100644 r/tests/testthat/_snaps/dplyr-eval.md create mode 100644 r/tests/testthat/_snaps/dplyr-funcs-datetime.md create mode 100644 r/tests/testthat/_snaps/dplyr-mutate.md create mode 100644 r/tests/testthat/test-dplyr-eval.R delete mode 100644 r/vignettes/developers/matchsubstringoptions.png delete mode 100644 r/vignettes/developers/starts_with_docs.png delete mode 100644 r/vignettes/developers/startswithdocs.png delete mode 100644 r/vignettes/developers/writing_bindings.Rmd diff --git a/r/R/dplyr-across.R b/r/R/dplyr-across.R index 0d85764f7fb35..6aeedc18f375e 100644 --- a/r/R/dplyr-across.R +++ b/r/R/dplyr-across.R @@ -34,7 +34,11 @@ expand_across <- function(.data, quos_in, exclude_cols = NULL) { ) if (!all(names(across_call[-1]) %in% c(".cols", ".fns", ".names"))) { - abort("`...` argument to `across()` is deprecated in dplyr and not supported in Arrow") + arrow_not_supported( + "`...` argument to `across()` is deprecated in dplyr and", + body = c(">" = "Convert your call into a function or formula including the arguments"), + call = rlang::caller_call() + ) } if (!is.null(across_call[[".cols"]])) { diff --git a/r/R/dplyr-arrange.R b/r/R/dplyr-arrange.R index c8594c77df000..fdc69a708d15d 100644 --- a/r/R/dplyr-arrange.R +++ b/r/R/dplyr-arrange.R @@ -19,47 +19,46 @@ # The following S3 methods are registered on load if dplyr is present arrange.arrow_dplyr_query <- function(.data, ..., .by_group = FALSE) { - call <- match.call() - .data <- as_adq(.data) - exprs <- expand_across(.data, quos(...)) + try_arrow_dplyr({ + .data <- as_adq(.data) + exprs <- expand_across(.data, quos(...)) - if (.by_group) { - # when the data is grouped and .by_group is TRUE, order the result by - # the grouping columns first - exprs <- c(quos(!!!dplyr::groups(.data)), exprs) - } - if (length(exprs) == 0) { - # Nothing to do - return(.data) - } - .data <- as_adq(.data) - # find and remove any dplyr::desc() and tidy-eval - # the arrange expressions inside an Arrow data_mask - sorts <- vector("list", length(exprs)) - descs <- logical(0) - mask <- arrow_mask(.data) - for (i in seq_along(exprs)) { - x <- find_and_remove_desc(exprs[[i]]) - exprs[[i]] <- x[["quos"]] - sorts[[i]] <- arrow_eval(exprs[[i]], mask) - names(sorts)[i] <- format_expr(exprs[[i]]) - if (inherits(sorts[[i]], "try-error")) { - msg <- paste("Expression", names(sorts)[i], "not supported in Arrow") - return(abandon_ship(call, .data, msg)) + if (.by_group) { + # when the data is grouped and .by_group is TRUE, order the result by + # the grouping columns first + exprs <- c(quos(!!!dplyr::groups(.data)), exprs) } - if (length(mask$.aggregations)) { - # dplyr lets you arrange on e.g. x < mean(x), but we haven't implemented it. - # But we could, the same way it works in mutate() via join, if someone asks. - # Until then, just error. - # TODO: add a test for this - msg <- paste("Expression", format_expr(expr), "not supported in arrange() in Arrow") - return(abandon_ship(call, .data, msg)) + if (length(exprs) == 0) { + # Nothing to do + return(.data) } - descs[i] <- x[["desc"]] - } - .data$arrange_vars <- c(sorts, .data$arrange_vars) - .data$arrange_desc <- c(descs, .data$arrange_desc) - .data + .data <- as_adq(.data) + # find and remove any dplyr::desc() and tidy-eval + # the arrange expressions inside an Arrow data_mask + sorts <- vector("list", length(exprs)) + descs <- logical(0) + mask <- arrow_mask(.data) + for (i in seq_along(exprs)) { + x <- find_and_remove_desc(exprs[[i]]) + exprs[[i]] <- x[["quos"]] + sorts[[i]] <- arrow_eval(exprs[[i]], mask) + names(sorts)[i] <- format_expr(exprs[[i]]) + if (length(mask$.aggregations)) { + # dplyr lets you arrange on e.g. x < mean(x), but we haven't implemented it. + # But we could, the same way it works in mutate() via join, if someone asks. + # Until then, just error. + # TODO: add a test for this + arrow_not_supported( + .actual_msg = "Expression not supported in arrange() in Arrow", + call = expr + ) + } + descs[i] <- x[["desc"]] + } + .data$arrange_vars <- c(sorts, .data$arrange_vars) + .data$arrange_desc <- c(descs, .data$arrange_desc) + .data + }) } arrange.Dataset <- arrange.ArrowTabular <- arrange.RecordBatchReader <- arrange.arrow_dplyr_query @@ -73,10 +72,9 @@ find_and_remove_desc <- function(quosure) { expr <- quo_get_expr(quosure) descending <- FALSE if (length(all.vars(expr)) < 1L) { - stop( - "Expression in arrange() does not contain any field names: ", - deparse(expr), - call. = FALSE + validation_error( + "Expression in arrange() does not contain any field names", + call = quosure ) } # Use a while loop to remove any number of nested pairs of enclosing @@ -90,7 +88,10 @@ find_and_remove_desc <- function(quosure) { # ensure desc() has only one argument (when an R expression is a function # call, length == 2 means it has exactly one argument) if (length(expr) > 2) { - stop("desc() expects only one argument", call. = FALSE) + validation_error( + "desc() expects only one argument", + call = expr + ) } # remove desc() and toggle descending expr <- expr[[2]] diff --git a/r/R/dplyr-datetime-helpers.R b/r/R/dplyr-datetime-helpers.R index c153f47cbafdb..8e6a7f6185366 100644 --- a/r/R/dplyr-datetime-helpers.R +++ b/r/R/dplyr-datetime-helpers.R @@ -18,10 +18,10 @@ check_time_locale <- function(locale = Sys.getlocale("LC_TIME")) { if (tolower(Sys.info()[["sysname"]]) == "windows" && locale != "C") { # MingW C++ std::locale only supports "C" and "POSIX" - stop(paste0( - "On Windows, time locales other than 'C' are not supported in Arrow. ", - "Consider setting `Sys.setlocale('LC_TIME', 'C')`" - )) + arrow_not_supported( + "On Windows, time locales other than 'C'", + body = c(">" = "Consider setting `Sys.setlocale('LC_TIME', 'C')`") + ) } locale } @@ -56,13 +56,15 @@ duration_from_chunks <- function(chunks) { matched_chunks <- accepted_chunks[pmatch(names(chunks), accepted_chunks, duplicates.ok = TRUE)] if (any(is.na(matched_chunks))) { - abort( - paste0( - "named `difftime` units other than: ", - oxford_paste(accepted_chunks, quote_symbol = "`"), - " not supported in Arrow. \nInvalid `difftime` parts: ", + arrow_not_supported( + paste( + "named `difftime` units other than:", + oxford_paste(accepted_chunks, quote_symbol = "`") + ), + body = c(i = paste( + "Invalid `difftime` parts:", oxford_paste(names(chunks[is.na(matched_chunks)]), quote_symbol = "`") - ) + )) ) } @@ -114,7 +116,6 @@ binding_as_date_character <- function(x, } binding_as_date_numeric <- function(x, origin = "1970-01-01") { - # Arrow does not support direct casting from double to date32(), but for # integer-like values we can go via int32() # TODO: revisit after ARROW-15798 @@ -442,7 +443,7 @@ parse_period_unit <- function(x) { unit <- as.integer(pmatch(str_unit_start, known_units)) - 1L if (any(is.na(unit))) { - abort( + validation_error( sprintf( "Invalid period name: '%s'", str_unit, @@ -484,13 +485,13 @@ parse_period_unit <- function(x) { # more special cases: lubridate imposes sensible maximum # values on the number of seconds, minutes and hours if (unit == 3L && multiple > 60) { - abort("Rounding with second > 60 is not supported") + validation_error("Rounding with second > 60 is not supported") } if (unit == 4L && multiple > 60) { - abort("Rounding with minute > 60 is not supported") + validation_error("Rounding with minute > 60 is not supported") } if (unit == 5L && multiple > 24) { - abort("Rounding with hour > 24 is not supported") + validation_error("Rounding with hour > 24 is not supported") } list(unit = unit, multiple = multiple) diff --git a/r/R/dplyr-eval.R b/r/R/dplyr-eval.R index 211c26cecce8c..1997d698c0b24 100644 --- a/r/R/dplyr-eval.R +++ b/r/R/dplyr-eval.R @@ -25,30 +25,64 @@ arrow_eval <- function(expr, mask) { add_user_functions_to_mask(expr, mask) # This yields an Expression as long as the `exprs` are implemented in Arrow. - # Otherwise, it returns a try-error + # Otherwise, it raises a classed error, either: + # * arrow_not_supported: the expression is not supported in Arrow; retry with + # regular dplyr may work + # * validation_error: the expression is known to be not valid, so don't + # recommend retrying with regular dplyr tryCatch(eval_tidy(expr, mask), error = function(e) { - # Look for the cases where bad input was given, i.e. this would fail - # in regular dplyr anyway, and let those raise those as errors; - # else, for things not supported in Arrow return a "try-error", - # which we'll handle differently + # Inspect why the expression failed, and add the expr as the `call` + # for better error messages msg <- conditionMessage(e) - if (getOption("arrow.debug", FALSE)) print(msg) - patterns <- .cache$i18ized_error_pattern - if (is.null(patterns)) { - patterns <- i18ize_error_messages() - # Memoize it - .cache$i18ized_error_pattern <- patterns - } - if (grepl(patterns, msg)) { + arrow_debug <- getOption("arrow.debug", FALSE) + if (arrow_debug) print(msg) + + # A few cases: + # 1. Evaluation raised one of our error classes. Add the expr as the call + # and re-raise it. + if (inherits(e, c("validation_error", "arrow_not_supported"))) { + e$call <- expr stop(e) } - out <- structure(msg, class = "try-error", condition = e) - if (grepl("not supported.*Arrow|NotImplemented", msg) || getOption("arrow.debug", FALSE)) { - # One of ours. Mark it so that consumers can handle it differently - class(out) <- c("arrow-try-error", class(out)) + # 2. Error is from assert_that: raise as validation_error + if (inherits(e, "assertError")) { + validation_error(msg, call = expr) + } + + # 3. Check to see if this is a standard R error message (not found etc.). + # Retry with dplyr won't help. + if (grepl(get_standard_error_messages(), msg)) { + # Raise the original error: it's actually helpful here + validation_error(msg, call = expr) + } + # 3b. Check to see if this is from match.arg. Retry with dplyr won't help. + if (is.language(e$call) && identical(as.character(e$call[[1]]), "match.arg")) { + # Raise the original error: it's actually helpful here + validation_error(msg, call = expr) + } + + # 4. Check for NotImplemented error raised from Arrow C++ code. + # Not sure where exactly we may raise this, but if we see it, it means + # that something isn't supported in Arrow. Retry in dplyr may help? + if (grepl("NotImplemented", msg)) { + arrow_not_supported(.actual_msg = msg, call = expr) + } + + + # 5. Otherwise, we're not sure why this errored: it's not an error we raised + # explicitly. We'll assume it's because the function it calls isn't + # supported in arrow, and retry with dplyr may help. + if (arrow_debug) { + arrow_not_supported(.actual_msg = msg, call = expr) + } else { + # Don't show the original error message unless in debug mode because + # it's probably not helpful: like, if you've passed an Expression to a + # regular R function that operates on strings, the way it errors would be + # more confusing than just saying that the expression is not supported + # in arrow. + arrow_not_supported("Expression", call = expr) } - invisible(out) }) } @@ -93,15 +127,12 @@ add_user_functions_to_mask <- function(expr, mask) { invisible() } -handle_arrow_not_supported <- function(err, lab) { - # Look for informative message from the Arrow function version (see above) - if (inherits(err, "arrow-try-error")) { - # Include it if found - paste0("In ", lab, ", ", as.character(err)) - } else { - # Otherwise be opaque (the original error is probably not useful) - paste("Expression", lab, "not supported in Arrow") +get_standard_error_messages <- function() { + if (is.null(.cache$i18ized_error_pattern)) { + # Memoize it + .cache$i18ized_error_pattern <- i18ize_error_messages() } + .cache$i18ized_error_pattern } i18ize_error_messages <- function() { @@ -114,10 +145,101 @@ i18ize_error_messages <- function() { paste(map(out, ~ sub("X_____X", ".*", .)), collapse = "|") } -# Helper to raise a common error -arrow_not_supported <- function(msg) { - # TODO: raise a classed error? - stop(paste(msg, "not supported in Arrow"), call. = FALSE) +#' Helpers to raise classed errors +#' +#' `arrow_not_supported()` and `validation_error()` raise classed errors that +#' allow us to distinguish between things that are not supported in Arrow and +#' things that are just invalid input. Additional wrapping in `arrow_eval()` +#' and `try_arrow_dplyr()` provide more context and suggestions. +#' Importantly, if `arrow_not_supported` is raised, then retrying the same code +#' in regular dplyr in R may work. But if `validation_error` is raised, then we +#' shouldn't recommend retrying with regular dplyr because it will fail there +#' too. +#' +#' Use these in function bindings and in the dplyr methods. Inside of function +#' bindings, you don't need to provide the `call` argument, as it will be +#' automatically filled in with the expression that caused the error in +#' `arrow_eval()`. In dplyr methods, you should provide the `call` argument; +#' `rlang::caller_call()` often is correct, but you may need to experiment to +#' find how far up the call stack you need to look. +#' +#' You may provide additional information in the `body` argument, a named +#' character vector. Use `i` for additional information about the error and `>` +#' to indicate potential solutions or workarounds that don't require pulling the +#' data into R. If you have an `arrow_not_supported()` error with a `>` +#' suggestion, when the error is ultimately raised by `try_error_dplyr()`, +#' `Call collect() first to pull data into R` won't be the only suggestion. +#' +#' You can still use `match.arg()` and `assert_that()` for simple input +#' validation inside of the function bindings. `arrow_eval()` will catch their +#' errors and re-raise them as `validation_error`. +#' +#' @param msg The message to show. `arrow_not_supported()` will append +#' "not supported in Arrow" to this message. +#' @param .actual_msg If you don't want to append "not supported in Arrow" to +#' the message, you can provide the full message here. +#' @param ... Additional arguments to pass to `rlang::abort()`. Useful arguments +#' include `call` to provide the call or expression that caused the error, and +#' `body` to provide additional context about the error. +#' @keywords internal +arrow_not_supported <- function(msg, + .actual_msg = paste(msg, "not supported in Arrow"), + ...) { + abort(.actual_msg, class = "arrow_not_supported", use_cli_format = TRUE, ...) +} + +#' @rdname arrow_not_supported +validation_error <- function(msg, ...) { + abort(msg, class = "validation_error", use_cli_format = TRUE, ...) +} + +# Wrap the contents of an arrow dplyr verb function in a tryCatch block to +# handle arrow_not_supported errors: +# * If it errors because of arrow_not_supported, abandon ship +# * If it's another error, just stop, retry with regular dplyr won't help +try_arrow_dplyr <- function(expr) { + parent <- caller_env() + # Make sure that the call is available in the parent environment + # so that we can use it in abandon_ship, if needed + evalq(call <- match.call(), parent) + + tryCatch( + eval(expr, parent), + arrow_not_supported = function(e) abandon_ship(e, parent) + ) +} + +# Helper to handle unsupported dplyr features +# * For Table/RecordBatch, we collect() and then call the dplyr method in R +# * For Dataset, we error and recommend collect() +# Requires that `env` contains `.data` +# The Table/RB path also requires `call` to be in `env` (try_arrow_dplyr adds it) +# and that the function being called also exists in the dplyr namespace. +abandon_ship <- function(err, env) { + .data <- get(".data", envir = env) + if (query_on_dataset(.data)) { + # Add a note suggesting `collect()` to the error message. + # If there are other suggestions already there (with the > arrow name), + # collect() isn't the only suggestion, so message differently + msg <- ifelse( + ">" %in% names(err$body), + "Or, call collect() first to pull data into R.", + "Call collect() first to pull data into R." + ) + err$body <- c(err$body, ">" = msg) + stop(err) + } + + # Else, warn, collect(), and run in regular dplyr + call <- get("call", envir = env) + rlang::warn( + message = paste0("In ", format_expr(err$call), ": "), + body = c("i" = conditionMessage(err), ">" = "Pulling data into R") + ) + call$.data <- dplyr::collect(.data) + dplyr_fun_name <- sub("^(.*?)\\..*", "\\1", as.character(call[[1]])) + call[[1]] <- get(dplyr_fun_name, envir = asNamespace("dplyr")) + eval(call, env) } # Create a data mask for evaluating a dplyr expression diff --git a/r/R/dplyr-filter.R b/r/R/dplyr-filter.R index 69decbd76655f..36219e411e56d 100644 --- a/r/R/dplyr-filter.R +++ b/r/R/dplyr-filter.R @@ -19,45 +19,45 @@ # The following S3 methods are registered on load if dplyr is present filter.arrow_dplyr_query <- function(.data, ..., .by = NULL, .preserve = FALSE) { - # TODO something with the .preserve argument - out <- as_adq(.data) + try_arrow_dplyr({ + # TODO something with the .preserve argument + out <- as_adq(.data) - by <- compute_by({{ .by }}, out, by_arg = ".by", data_arg = ".data") + by <- compute_by({{ .by }}, out, by_arg = ".by", data_arg = ".data") - if (by$from_by) { - out$group_by_vars <- by$names - } - - expanded_filters <- expand_across(out, quos(...)) - if (length(expanded_filters) == 0) { - # Nothing to do - return(as_adq(.data)) - } + if (by$from_by) { + out$group_by_vars <- by$names + } - # tidy-eval the filter expressions inside an Arrow data_mask - mask <- arrow_mask(out) - for (expr in expanded_filters) { - filt <- arrow_eval(expr, mask) - if (inherits(filt, "try-error")) { - msg <- handle_arrow_not_supported(filt, format_expr(expr)) - return(abandon_ship(match.call(), .data, msg)) + expanded_filters <- expand_across(out, quos(...)) + if (length(expanded_filters) == 0) { + # Nothing to do + return(as_adq(.data)) } - if (length(mask$.aggregations)) { - # dplyr lets you filter on e.g. x < mean(x), but we haven't implemented it. - # But we could, the same way it works in mutate() via join, if someone asks. - # Until then, just error. - # TODO: add a test for this - msg <- paste("Expression", format_expr(expr), "not supported in filter() in Arrow") - return(abandon_ship(match.call(), .data, msg)) + + # tidy-eval the filter expressions inside an Arrow data_mask + mask <- arrow_mask(out) + for (expr in expanded_filters) { + filt <- arrow_eval(expr, mask) + if (length(mask$.aggregations)) { + # dplyr lets you filter on e.g. x < mean(x), but we haven't implemented it. + # But we could, the same way it works in mutate() via join, if someone asks. + # Until then, just error. + # TODO: add a test for this + arrow_not_supported( + .actual_msg = "Expression not supported in filter() in Arrow", + call = expr + ) + } + out <- set_filters(out, filt) } - out <- set_filters(out, filt) - } - if (by$from_by) { - out$group_by_vars <- character() - } + if (by$from_by) { + out$group_by_vars <- character() + } - out + out + }) } filter.Dataset <- filter.ArrowTabular <- filter.RecordBatchReader <- filter.arrow_dplyr_query diff --git a/r/R/dplyr-funcs-agg.R b/r/R/dplyr-funcs-agg.R index c0c4eb3089425..340ebe7adc90f 100644 --- a/r/R/dplyr-funcs-agg.R +++ b/r/R/dplyr-funcs-agg.R @@ -155,7 +155,7 @@ register_bindings_aggregate <- function() { set_agg <- function(...) { agg_data <- list2(...) # Find the environment where .aggregations is stored - target <- find_aggregations_env() + target <- find_arrow_mask() aggs <- get(".aggregations", target) lapply(agg_data[["data"]], function(expr) { # If any of the fields referenced in the expression are in .aggregations, @@ -176,8 +176,8 @@ set_agg <- function(...) { Expression$field_ref(tmpname) } -find_aggregations_env <- function() { - # Find the environment where .aggregations is stored, +find_arrow_mask <- function() { + # Find the arrow_mask environment by looking for .aggregations, # it's in parent.env of something in the call stack n <- 1 while (TRUE) { diff --git a/r/R/dplyr-funcs-conditional.R b/r/R/dplyr-funcs-conditional.R index b9639f00295ce..3ab955aa8aee4 100644 --- a/r/R/dplyr-funcs-conditional.R +++ b/r/R/dplyr-funcs-conditional.R @@ -37,7 +37,7 @@ register_bindings_conditional <- function() { register_binding("dplyr::coalesce", function(...) { args <- list2(...) if (length(args) < 1) { - abort("At least one argument must be supplied to coalesce()") + validation_error("At least one argument must be supplied to coalesce()") } # Treat NaN like NA for consistency with dplyr::coalesce(), but if *all* @@ -102,7 +102,7 @@ register_bindings_conditional <- function() { formulas <- list2(...) n <- length(formulas) if (n == 0) { - abort("No cases provided in case_when()") + validation_error("No cases provided") } query <- vector("list", n) value <- vector("list", n) @@ -110,20 +110,17 @@ register_bindings_conditional <- function() { for (i in seq_len(n)) { f <- formulas[[i]] if (!inherits(f, "formula")) { - abort("Each argument to case_when() must be a two-sided formula") + validation_error("Each argument to case_when() must be a two-sided formula") } query[[i]] <- arrow_eval(f[[2]], mask) value[[i]] <- arrow_eval(f[[3]], mask) if (!call_binding("is.logical", query[[i]])) { - abort("Left side of each formula in case_when() must be a logical expression") - } - if (inherits(value[[i]], "try-error")) { - abort(handle_arrow_not_supported(value[[i]], format_expr(f[[3]]))) + validation_error("Left side of each formula in case_when() must be a logical expression") } } if (!is.null(.default)) { if (length(.default) != 1) { - abort(paste0("`.default` must have size 1, not size ", length(.default), ".")) + validation_error(paste0("`.default` must have size 1, not size ", length(.default), ".")) } query[n + 1] <- TRUE @@ -140,6 +137,5 @@ register_bindings_conditional <- function() { value ) ) - }, notes = "`.ptype` and `.size` arguments not supported" - ) + }, notes = "`.ptype` and `.size` arguments not supported") } diff --git a/r/R/dplyr-funcs-datetime.R b/r/R/dplyr-funcs-datetime.R index 440210afd630c..5e6ac4a1035f8 100644 --- a/r/R/dplyr-funcs-datetime.R +++ b/r/R/dplyr-funcs-datetime.R @@ -121,7 +121,7 @@ register_bindings_datetime_utility <- function() { precision <- "ymdhms" } if (!precision %in% names(ISO8601_precision_map)) { - abort( + validation_error( paste( "`precision` must be one of the following values:", paste(names(ISO8601_precision_map), collapse = ", "), @@ -325,10 +325,10 @@ register_bindings_datetime_conversion <- function() { origin = "1970-01-01", tz = "UTC") { if (is.null(format) && length(tryFormats) > 1) { - abort( - paste( - "`as.Date()` with multiple `tryFormats` is not supported in Arrow.", - "Consider using the lubridate specialised parsing functions `ymd()`, `ymd()`, etc." + arrow_not_supported( + "`as.Date()` with multiple `tryFormats`", + body = c( + ">" = "Consider using the lubridate specialised parsing functions `ymd()`, `ymd()`, etc." ) ) } @@ -455,15 +455,13 @@ register_bindings_datetime_timezone <- function() { arrow_not_supported("`roll_dst` must be 1 or 2 items long; other lengths") } - nonexistent <- switch( - roll_dst[1], + nonexistent <- switch(roll_dst[1], "error" = 0L, "boundary" = 2L, arrow_not_supported("`roll_dst` value must be 'error' or 'boundary' for nonexistent times; other values") ) - ambiguous <- switch( - roll_dst[2], + ambiguous <- switch(roll_dst[2], "error" = 0L, "pre" = 1L, "post" = 2L, @@ -651,7 +649,7 @@ register_bindings_duration_helpers <- function() { register_binding( "lubridate::dpicoseconds", function(x = 1) { - abort("Duration in picoseconds not supported in Arrow.") + arrow_not_supported("Duration in picoseconds") }, notes = "not supported" ) diff --git a/r/R/dplyr-funcs-simple.R b/r/R/dplyr-funcs-simple.R index 308a46601a6db..4ccc2498435b3 100644 --- a/r/R/dplyr-funcs-simple.R +++ b/r/R/dplyr-funcs-simple.R @@ -177,7 +177,7 @@ common_type <- function(exprs) { # * pmin/pmax return(first_type) } - stop("There is no common type in these expressions") + validation_error("There is no common type in these expressions") } cast_or_parse <- function(x, type) { diff --git a/r/R/dplyr-funcs-string.R b/r/R/dplyr-funcs-string.R index a21ce78edd189..77e1a5405a692 100644 --- a/r/R/dplyr-funcs-string.R +++ b/r/R/dplyr-funcs-string.R @@ -134,9 +134,9 @@ format_string_replacement <- function(replacement, ignore.case, fixed) { # Arrow locale will be supported with ARROW-14126 stop_if_locale_provided <- function(locale) { if (!identical(locale, "en")) { - stop("Providing a value for 'locale' other than the default ('en') is not supported in Arrow. ", - "To change locale, use 'Sys.setlocale()'", - call. = FALSE + arrow_not_supported( + "Providing a value for 'locale' other than the default ('en')", + body = c(">" = "To change locale, use 'Sys.setlocale()'") ) } } @@ -158,10 +158,11 @@ register_bindings_string_join <- function() { # handle scalar literal args, and cast all args to string for # consistency with base::paste(), base::paste0(), and stringr::str_c() if (!inherits(arg, "Expression")) { - assert_that( - length(arg) == 1, - msg = "Literal vectors of length != 1 not supported in string concatenation" - ) + if (length(arg) != 1) { + arrow_not_supported( + "Literal vectors of length != 1 in string concatenation" + ) + } Expression$scalar(as.character(arg)) } else { call_binding("as.character", arg) @@ -181,12 +182,11 @@ register_bindings_string_join <- function() { register_binding( "base::paste", function(..., sep = " ", collapse = NULL, recycle0 = FALSE) { - assert_that( - is.null(collapse), - msg = "paste() with the collapse argument is not yet supported in Arrow" - ) - if (!inherits(sep, "Expression")) { - assert_that(!is.na(sep), msg = "Invalid separator") + if (!is.null(collapse)) { + arrow_not_supported("`collapse` argument") + } + if (!inherits(sep, "Expression") && is.na(sep)) { + validation_error("Invalid separator") } arrow_string_join_function(NullHandlingBehavior$REPLACE, "NA")(..., sep) }, @@ -196,10 +196,9 @@ register_bindings_string_join <- function() { register_binding( "base::paste0", function(..., collapse = NULL, recycle0 = FALSE) { - assert_that( - is.null(collapse), - msg = "paste0() with the collapse argument is not yet supported in Arrow" - ) + if (!is.null(collapse)) { + arrow_not_supported("`collapse` argument") + } arrow_string_join_function(NullHandlingBehavior$REPLACE, "NA")(..., "") }, notes = "the `collapse` argument is not yet supported" @@ -208,12 +207,11 @@ register_bindings_string_join <- function() { register_binding( "stringr::str_c", function(..., sep = "", collapse = NULL) { - assert_that( - is.null(collapse), - msg = "str_c() with the collapse argument is not yet supported in Arrow" - ) - if (!inherits(sep, "Expression")) { - assert_that(!is.na(sep), msg = "`sep` must be a single string, not `NA`.") + if (!is.null(collapse)) { + arrow_not_supported("`collapse` argument") + } + if (!inherits(sep, "Expression") && is.na(sep)) { + validation_error("`sep` must be a single string, not `NA`.") } arrow_string_join_function(NullHandlingBehavior$EMIT_NULL)(..., sep) }, @@ -352,10 +350,10 @@ register_bindings_string_regex <- function() { arrow_r_string_replace_function <- function(max_replacements) { function(pattern, replacement, x, ignore.case = FALSE, fixed = FALSE) { if (length(pattern) != 1) { - stop("`pattern` must be a length 1 character vector") + validation_error("`pattern` must be a length 1 character vector") } if (length(replacement) != 1) { - stop("`replacement` must be a length 1 character vector") + validation_error("`replacement` must be a length 1 character vector") } Expression$create( ifelse(fixed && !ignore.case, "replace_substring", "replace_substring_regex"), @@ -512,14 +510,12 @@ register_bindings_string_other <- function() { register_binding( "base::substr", function(x, start, stop) { - assert_that( - length(start) == 1, - msg = "`start` must be length 1 - other lengths are not supported in Arrow" - ) - assert_that( - length(stop) == 1, - msg = "`stop` must be length 1 - other lengths are not supported in Arrow" - ) + if (length(start) != 1) { + arrow_not_supported("`start` must be length 1 - other lengths") + } + if (length(stop) != 1) { + arrow_not_supported("`stop` must be length 1 - other lengths") + } # substr treats values as if they're on a continuous number line, so values # 0 are effectively blank characters - set `start` to 1 here so Arrow mimics @@ -561,14 +557,12 @@ register_bindings_string_other <- function() { }) register_binding("stringr::str_sub", function(string, start = 1L, end = -1L) { - assert_that( - length(start) == 1, - msg = "`start` must be length 1 - other lengths are not supported in Arrow" - ) - assert_that( - length(end) == 1, - msg = "`end` must be length 1 - other lengths are not supported in Arrow" - ) + if (length(start) != 1) { + arrow_not_supported("`start` must be length 1 - other lengths") + } + if (length(end) != 1) { + arrow_not_supported("`end` must be length 1 - other lengths") + } # In stringr::str_sub, an `end` value of -1 means the end of the string, so # set it to the maximum integer to match this behavior diff --git a/r/R/dplyr-funcs-type.R b/r/R/dplyr-funcs-type.R index efb3c6b756a16..85c26ec05c8ba 100644 --- a/r/R/dplyr-funcs-type.R +++ b/r/R/dplyr-funcs-type.R @@ -105,7 +105,7 @@ register_bindings_type_cast <- function() { } else if (inherits(class2, "DataType")) { object$type() == as_type(class2) } else { - stop("Second argument to is() is not a string or DataType", call. = FALSE) + validation_error("Second argument to is() is not a string or DataType") } }) @@ -219,7 +219,10 @@ register_bindings_type_inspect <- function() { call_binding("is.character", x) }) register_binding("rlang::is_double", function(x, n = NULL, finite = NULL) { - assert_that(is.null(n) && is.null(finite)) + assert_that(is.null(n)) + if (!is.null(finite)) { + arrow_not_supported("`finite` argument") + } call_binding("is.double", x) }) register_binding("rlang::is_integer", function(x, n = NULL) { diff --git a/r/R/dplyr-mutate.R b/r/R/dplyr-mutate.R index f0a8c005676df..fcb1cedbbb168 100644 --- a/r/R/dplyr-mutate.R +++ b/r/R/dplyr-mutate.R @@ -24,122 +24,116 @@ mutate.arrow_dplyr_query <- function(.data, .keep = c("all", "used", "unused", "none"), .before = NULL, .after = NULL) { - call <- match.call() - out <- as_adq(.data) + try_arrow_dplyr({ + out <- as_adq(.data) - by <- compute_by({{ .by }}, out, by_arg = ".by", data_arg = ".data") + by <- compute_by({{ .by }}, out, by_arg = ".by", data_arg = ".data") - if (by$from_by) { - out$group_by_vars <- by$names - } - grv <- out$group_by_vars - expression_list <- expand_across(out, quos(...), exclude_cols = grv) - exprs <- ensure_named_exprs(expression_list) + if (by$from_by) { + out$group_by_vars <- by$names + } + grv <- out$group_by_vars + expression_list <- expand_across(out, quos(...), exclude_cols = grv) + exprs <- ensure_named_exprs(expression_list) - .keep <- match.arg(.keep) - .before <- enquo(.before) - .after <- enquo(.after) + .keep <- match.arg(.keep) + .before <- enquo(.before) + .after <- enquo(.after) - if (.keep %in% c("all", "unused") && length(exprs) == 0) { - # Nothing to do - return(out) - } + if (.keep %in% c("all", "unused") && length(exprs) == 0) { + # Nothing to do + return(out) + } - # Create a mask with aggregation functions in it - # If there are any aggregations, we will need to compute them and - # and join the results back in, for "window functions" like x - mean(x) - mask <- arrow_mask(out) - # Evaluate the mutate expressions - results <- list() - for (i in seq_along(exprs)) { - # Iterate over the indices and not the names because names may be repeated - # (which overwrites the previous name) - new_var <- names(exprs)[i] - results[[new_var]] <- arrow_eval(exprs[[i]], mask) - if (inherits(results[[new_var]], "try-error")) { - msg <- handle_arrow_not_supported( - results[[new_var]], - format_expr(exprs[[i]]) - ) - return(abandon_ship(call, .data, msg)) - } else if (!inherits(results[[new_var]], "Expression") && - !is.null(results[[new_var]])) { - # We need some wrapping to handle literal values - if (length(results[[new_var]]) != 1) { - msg <- paste0("In ", new_var, " = ", format_expr(exprs[[i]]), ", only values of size one are recycled") - return(abandon_ship(call, .data, msg)) + # Create a mask with aggregation functions in it + # If there are any aggregations, we will need to compute them and + # and join the results back in, for "window functions" like x - mean(x) + mask <- arrow_mask(out) + # Evaluate the mutate expressions + results <- list() + for (i in seq_along(exprs)) { + # Iterate over the indices and not the names because names may be repeated + # (which overwrites the previous name) + new_var <- names(exprs)[i] + results[[new_var]] <- arrow_eval(exprs[[i]], mask) + if (!inherits(results[[new_var]], "Expression") && + !is.null(results[[new_var]])) { + # We need some wrapping to handle literal values + if (length(results[[new_var]]) != 1) { + arrow_not_supported("Recycling values of length != 1", call = exprs[[i]]) + } + results[[new_var]] <- Expression$scalar(results[[new_var]]) } - results[[new_var]] <- Expression$scalar(results[[new_var]]) + # Put it in the data mask too + mask[[new_var]] <- mask$.data[[new_var]] <- results[[new_var]] } - # Put it in the data mask too - mask[[new_var]] <- mask$.data[[new_var]] <- results[[new_var]] - } - if (length(mask$.aggregations)) { - # Make a copy of .data, do the aggregations on it, and then left_join on - # the group_by variables. - agg_query <- as_adq(.data) - # These may be computed by .by, make sure they're set - agg_query$group_by_vars <- grv - agg_query$aggregations <- mask$.aggregations - agg_query <- collapse.arrow_dplyr_query(agg_query) - if (length(grv)) { - out <- dplyr::left_join(out, agg_query, by = grv) - } else { - # If there are no group_by vars, add a scalar column to both and join on that - agg_query$selected_columns[["..tempjoin"]] <- Expression$scalar(1L) - out$selected_columns[["..tempjoin"]] <- Expression$scalar(1L) - out <- dplyr::left_join(out, agg_query, by = "..tempjoin") + if (length(mask$.aggregations)) { + # Make a copy of .data, do the aggregations on it, and then left_join on + # the group_by variables. + agg_query <- as_adq(.data) + # These may be computed by .by, make sure they're set + agg_query$group_by_vars <- grv + agg_query$aggregations <- mask$.aggregations + agg_query <- collapse.arrow_dplyr_query(agg_query) + if (length(grv)) { + out <- left_join(out, agg_query, by = grv) + } else { + # If there are no group_by vars, add a scalar column to both and join on that + agg_query$selected_columns[["..tempjoin"]] <- Expression$scalar(1L) + out$selected_columns[["..tempjoin"]] <- Expression$scalar(1L) + out <- left_join(out, agg_query, by = "..tempjoin") + } } - } - old_vars <- names(out$selected_columns) - # Note that this is names(exprs) not names(results): - # if results$new_var is NULL, that means we are supposed to remove it - new_vars <- names(exprs) + old_vars <- names(out$selected_columns) + # Note that this is names(exprs) not names(results): + # if results$new_var is NULL, that means we are supposed to remove it + new_vars <- names(exprs) - # Assign the new columns into the out$selected_columns - for (new_var in new_vars) { - out$selected_columns[[new_var]] <- results[[new_var]] - } + # Assign the new columns into the out$selected_columns + for (new_var in new_vars) { + out$selected_columns[[new_var]] <- results[[new_var]] + } - # Prune any ..temp columns from the result, which would have come from - # .aggregations - temps <- grepl("^\\.\\.temp", names(out$selected_columns)) - out$selected_columns <- out$selected_columns[!temps] + # Prune any ..temp columns from the result, which would have come from + # .aggregations + temps <- grepl("^\\.\\.temp", names(out$selected_columns)) + out$selected_columns <- out$selected_columns[!temps] - # Deduplicate new_vars and remove NULL columns from new_vars - new_vars <- intersect(union(new_vars, grv), names(out$selected_columns)) + # Deduplicate new_vars and remove NULL columns from new_vars + new_vars <- intersect(union(new_vars, grv), names(out$selected_columns)) - # Respect .before and .after - if (!quo_is_null(.before) || !quo_is_null(.after)) { - new <- setdiff(new_vars, old_vars) - out <- dplyr::relocate(out, all_of(new), .before = !!.before, .after = !!.after) - } + # Respect .before and .after + if (!quo_is_null(.before) || !quo_is_null(.after)) { + new <- setdiff(new_vars, old_vars) + out <- dplyr::relocate(out, all_of(new), .before = !!.before, .after = !!.after) + } - # Respect .keep - if (.keep == "none") { - ## for consistency with dplyr, this appends new columns after existing columns - ## by specifying the order - new_cols_last <- c(intersect(old_vars, new_vars), setdiff(new_vars, old_vars)) - out$selected_columns <- out$selected_columns[new_cols_last] - } else if (.keep != "all") { - # "used" or "unused" - used_vars <- unlist(lapply(exprs, all.vars), use.names = FALSE) - if (.keep == "used") { - out$selected_columns[setdiff(old_vars, used_vars)] <- NULL - } else { - # "unused" - out$selected_columns[intersect(old_vars, used_vars)] <- NULL + # Respect .keep + if (.keep == "none") { + ## for consistency with dplyr, this appends new columns after existing columns + ## by specifying the order + new_cols_last <- c(intersect(old_vars, new_vars), setdiff(new_vars, old_vars)) + out$selected_columns <- out$selected_columns[new_cols_last] + } else if (.keep != "all") { + # "used" or "unused" + used_vars <- unlist(lapply(exprs, all.vars), use.names = FALSE) + if (.keep == "used") { + out$selected_columns[setdiff(old_vars, used_vars)] <- NULL + } else { + # "unused" + out$selected_columns[intersect(old_vars, used_vars)] <- NULL + } } - } - if (by$from_by) { - out$group_by_vars <- character() - } + if (by$from_by) { + out$group_by_vars <- character() + } - # Even if "none", we still keep group vars - ensure_group_vars(out) + # Even if "none", we still keep group vars + ensure_group_vars(out) + }) } mutate.Dataset <- mutate.ArrowTabular <- mutate.RecordBatchReader <- mutate.arrow_dplyr_query diff --git a/r/R/dplyr-slice.R b/r/R/dplyr-slice.R index bcb6547f7c8e9..2173d897f1f9d 100644 --- a/r/R/dplyr-slice.R +++ b/r/R/dplyr-slice.R @@ -148,7 +148,7 @@ prop_to_n <- function(.data, prop) { validate_prop <- function(prop) { if (!is.numeric(prop) || length(prop) != 1 || is.na(prop) || prop < 0 || prop > 1) { - stop("`prop` must be a single numeric value between 0 and 1", call. = FALSE) + validation_error("`prop` must be a single numeric value between 0 and 1") } } diff --git a/r/R/dplyr-summarize.R b/r/R/dplyr-summarize.R index 58ca849152a75..f4fda0f13aabd 100644 --- a/r/R/dplyr-summarize.R +++ b/r/R/dplyr-summarize.R @@ -18,39 +18,18 @@ # The following S3 methods are registered on load if dplyr is present summarise.arrow_dplyr_query <- function(.data, ..., .by = NULL, .groups = NULL) { - call <- match.call() - out <- as_adq(.data) + try_arrow_dplyr({ + out <- as_adq(.data) - by <- compute_by({{ .by }}, out, by_arg = ".by", data_arg = ".data") - - if (by$from_by) { - out$group_by_vars <- by$names - .groups <- "drop" - } - - exprs <- expand_across(out, quos(...), exclude_cols = out$group_by_vars) - - # Only retain the columns we need to do our aggregations - vars_to_keep <- unique(c( - unlist(lapply(exprs, all.vars)), # vars referenced in summarise - dplyr::group_vars(out) # vars needed for grouping - )) - # If exprs rely on the results of previous exprs - # (total = sum(x), mean = total / n()) - # then not all vars will correspond to columns in the data, - # so don't try to select() them (use intersect() to exclude them) - # Note that this select() isn't useful for the Arrow summarize implementation - # because it will effectively project to keep what it needs anyway, - # but the data.frame fallback version does benefit from select here - out <- dplyr::select(out, intersect(vars_to_keep, names(out))) - - # Try stuff, if successful return() - out <- try(do_arrow_summarize(out, !!!exprs, .groups = .groups), silent = TRUE) - if (inherits(out, "try-error")) { - out <- abandon_ship(call, .data, format(out)) - } + by <- compute_by({{ .by }}, out, by_arg = ".by", data_arg = ".data") + if (by$from_by) { + out$group_by_vars <- by$names + .groups <- "drop" + } - out + exprs <- expand_across(out, quos(...), exclude_cols = out$group_by_vars) + do_arrow_summarize(out, !!!exprs, .groups = .groups) + }) } summarise.Dataset <- summarise.ArrowTabular <- summarise.RecordBatchReader <- summarise.arrow_dplyr_query @@ -120,11 +99,10 @@ do_arrow_summarize <- function(.data, ..., .groups = NULL) { # the schema of the data after summarize(). Evaulating its type will # throw an error if it's invalid. tryCatch(post_mutate[[post]]$type(out$.data$schema), error = function(e) { - msg <- paste( - "Expression", as_label(exprs[[post]]), - "is not a valid aggregation expression or is" + arrow_not_supported( + "Expression is not a valid aggregation expression or is", + call = exprs[[post]] ) - arrow_not_supported(msg) }) # If it's valid, add it to the .data object out$selected_columns[[post]] <- post_mutate[[post]] @@ -166,12 +144,18 @@ do_arrow_summarize <- function(.data, ..., .groups = NULL) { } else if (.groups == "keep") { out$group_by_vars <- .data$group_by_vars } else if (.groups == "rowwise") { - stop(arrow_not_supported('.groups = "rowwise"')) + arrow_not_supported( + '.groups = "rowwise"', + call = rlang::caller_call() + ) } else if (.groups == "drop") { # collapse() preserves groups so remove them out <- dplyr::ungroup(out) } else { - stop(paste("Invalid .groups argument:", .groups)) + validation_error( + paste("Invalid .groups argument:", .groups), + call = rlang::caller_call() + ) } out$drop_empty_groups <- .data$drop_empty_groups if (getOption("arrow.summarise.sort", FALSE)) { @@ -183,16 +167,6 @@ do_arrow_summarize <- function(.data, ..., .groups = NULL) { out } -arrow_eval_or_stop <- function(expr, mask) { - # TODO: change arrow_eval error handling behavior? - out <- arrow_eval(expr, mask) - if (inherits(out, "try-error")) { - msg <- handle_arrow_not_supported(out, format_expr(expr)) - stop(msg, call. = FALSE) - } - out -} - # This function returns a list of expressions which is used to project the data # before an aggregation. This list includes the fields used in the aggregation # expressions (the "targets") and the group fields. The names of the returned @@ -271,7 +245,7 @@ summarize_eval <- function(name, quosure, mask) { mask[[n]] <- mask$.data[[n]] <- Expression$field_ref(n) } # Evaluate: - value <- arrow_eval_or_stop(quosure, mask) + value <- arrow_eval(quosure, mask) # Handle the result. There are a few different cases. if (!inherits(value, "Expression")) { diff --git a/r/R/dplyr.R b/r/R/dplyr.R index f11b88d301ef9..93fcfdef28f28 100644 --- a/r/R/dplyr.R +++ b/r/R/dplyr.R @@ -338,22 +338,6 @@ ensure_arrange_vars <- function(x) { x } -# Helper to handle unsupported dplyr features -# * For Table/RecordBatch, we collect() and then call the dplyr method in R -# * For Dataset, we just error -abandon_ship <- function(call, .data, msg) { - msg <- trimws(msg) - dplyr_fun_name <- sub("^(.*?)\\..*", "\\1", as.character(call[[1]])) - if (query_on_dataset(.data)) { - stop(msg, "\nCall collect() first to pull data into R.", call. = FALSE) - } - # else, collect and call dplyr method - warning(msg, "; pulling data into R", immediate. = TRUE, call. = FALSE) - call$.data <- dplyr::collect(.data) - call[[1]] <- get(dplyr_fun_name, envir = asNamespace("dplyr")) - eval.parent(call, 2) -} - query_on_dataset <- function(x) { any(map_lgl(all_sources(x), ~ inherits(., c("Dataset", "RecordBatchReader")))) } diff --git a/r/man/arrow_not_supported.Rd b/r/man/arrow_not_supported.Rd new file mode 100644 index 0000000000000..be6a001fa1fa4 --- /dev/null +++ b/r/man/arrow_not_supported.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dplyr-eval.R +\name{arrow_not_supported} +\alias{arrow_not_supported} +\alias{validation_error} +\title{Helpers to raise classed errors} +\usage{ +arrow_not_supported( + msg, + .actual_msg = paste(msg, "not supported in Arrow"), + ... +) + +validation_error(msg, ...) +} +\arguments{ +\item{msg}{The message to show. \code{arrow_not_supported()} will append +"not supported in Arrow" to this message.} + +\item{.actual_msg}{If you don't want to append "not supported in Arrow" to +the message, you can provide the full message here.} + +\item{...}{Additional arguments to pass to \code{rlang::abort()}. Useful arguments +include \code{call} to provide the call or expression that caused the error, and +\code{body} to provide additional context about the error.} +} +\description{ +\code{arrow_not_supported()} and \code{validation_error()} raise classed errors that +allow us to distinguish between things that are not supported in Arrow and +things that are just invalid input. Additional wrapping in \code{arrow_eval()} +and \code{try_arrow_dplyr()} provide more context and suggestions. +Importantly, if \code{arrow_not_supported} is raised, then retrying the same code +in regular dplyr in R may work. But if \code{validation_error} is raised, then we +shouldn't recommend retrying with regular dplyr because it will fail there +too. +} +\details{ +Use these in function bindings and in the dplyr methods. Inside of function +bindings, you don't need to provide the \code{call} argument, as it will be +automatically filled in with the expression that caused the error in +\code{arrow_eval()}. In dplyr methods, you should provide the \code{call} argument; +\code{rlang::caller_call()} often is correct, but you may need to experiment to +find how far up the call stack you need to look. + +You may provide additional information in the \code{body} argument, a named +character vector. Use \code{i} for additional information about the error and \code{>} +to indicate potential solutions or workarounds that don't require pulling the +data into R. If you have an \code{arrow_not_supported()} error with a \code{>} +suggestion, when the error is ultimately raised by \code{try_error_dplyr()}, +\verb{Call collect() first to pull data into R} won't be the only suggestion. + +You can still use \code{match.arg()} and \code{assert_that()} for simple input +validation inside of the function bindings. \code{arrow_eval()} will catch their +errors and re-raise them as \code{validation_error}. +} +\keyword{internal} diff --git a/r/tests/testthat/_snaps/dataset-dplyr.md b/r/tests/testthat/_snaps/dataset-dplyr.md new file mode 100644 index 0000000000000..a2d9820a4e78a --- /dev/null +++ b/r/tests/testthat/_snaps/dataset-dplyr.md @@ -0,0 +1,9 @@ +# dplyr method not implemented messages + + Code + ds %>% filter(int > 6, dbl > max(dbl)) + Condition + Error in `dbl > max(dbl)`: + ! Expression not supported in filter() in Arrow + > Call collect() first to pull data into R. + diff --git a/r/tests/testthat/_snaps/dplyr-across.md b/r/tests/testthat/_snaps/dplyr-across.md new file mode 100644 index 0000000000000..47b5bd61b39ce --- /dev/null +++ b/r/tests/testthat/_snaps/dplyr-across.md @@ -0,0 +1,11 @@ +# expand_across correctly expands quosures + + Code + InMemoryDataset$create(example_data) %>% mutate(across(c(dbl, dbl2), round, + digits = -1)) + Condition + Error in `mutate.Dataset()`: + ! `...` argument to `across()` is deprecated in dplyr and not supported in Arrow + > Convert your call into a function or formula including the arguments + > Or, call collect() first to pull data into R. + diff --git a/r/tests/testthat/_snaps/dplyr-eval.md b/r/tests/testthat/_snaps/dplyr-eval.md new file mode 100644 index 0000000000000..0b4639f1fe7a7 --- /dev/null +++ b/r/tests/testthat/_snaps/dplyr-eval.md @@ -0,0 +1,27 @@ +# try_arrow_dplyr/abandon_ship adds the right message about collect() + + Code + tester(ds, i) + Condition + Error in `validation_error()`: + ! arg is 0 + +--- + + Code + tester(ds, i) + Condition + Error in `arrow_not_supported()`: + ! arg == 1 not supported in Arrow + > Call collect() first to pull data into R. + +--- + + Code + tester(ds, i) + Condition + Error in `arrow_not_supported()`: + ! arg greater than 0 not supported in Arrow + > Try setting arg to -1 + > Or, call collect() first to pull data into R. + diff --git a/r/tests/testthat/_snaps/dplyr-funcs-datetime.md b/r/tests/testthat/_snaps/dplyr-funcs-datetime.md new file mode 100644 index 0000000000000..036c8b49e80a0 --- /dev/null +++ b/r/tests/testthat/_snaps/dplyr-funcs-datetime.md @@ -0,0 +1,11 @@ +# `as.Date()` and `as_date()` + + Code + test_df %>% InMemoryDataset$create() %>% transmute(date_char_ymd = as.Date( + character_ymd_var, tryFormats = c("%Y-%m-%d", "%Y/%m/%d"))) %>% collect() + Condition + Error in `as.Date()`: + ! `as.Date()` with multiple `tryFormats` not supported in Arrow + > Consider using the lubridate specialised parsing functions `ymd()`, `ymd()`, etc. + > Or, call collect() first to pull data into R. + diff --git a/r/tests/testthat/_snaps/dplyr-mutate.md b/r/tests/testthat/_snaps/dplyr-mutate.md new file mode 100644 index 0000000000000..a5bbc0163bc4f --- /dev/null +++ b/r/tests/testthat/_snaps/dplyr-mutate.md @@ -0,0 +1,25 @@ +# transmute() defuses dots arguments (ARROW-13262) + + Code + tbl %>% Table$create() %>% transmute(a = stringr::str_c(padded_strings, + padded_strings), b = stringr::str_squish(a)) %>% collect() + Condition + Warning: + In stringr::str_squish(a): + i Expression not supported in Arrow + > Pulling data into R + Output + # A tibble: 10 x 2 + a b + + 1 " a a " a a + 2 " b b " b b + 3 " c c " c c + 4 " d d " d d + 5 " e e " e e + 6 " f f " f f + 7 " g g " g g + 8 " h h " h h + 9 " i i " i i + 10 " j j " j j + diff --git a/r/tests/testthat/_snaps/dplyr-query.md b/r/tests/testthat/_snaps/dplyr-query.md index a9d4da26cca0b..cf5ac594acb2b 100644 --- a/r/tests/testthat/_snaps/dplyr-query.md +++ b/r/tests/testthat/_snaps/dplyr-query.md @@ -1,4 +1,6 @@ # Scalars in expressions match the type of the field, if possible - Expression int == "5" not supported in Arrow; pulling data into R + In int == "5": + i Expression not supported in Arrow + > Pulling data into R diff --git a/r/tests/testthat/_snaps/dplyr-summarize.md b/r/tests/testthat/_snaps/dplyr-summarize.md index bbb8e64bfe790..449a194d68fe5 100644 --- a/r/tests/testthat/_snaps/dplyr-summarize.md +++ b/r/tests/testthat/_snaps/dplyr-summarize.md @@ -3,11 +3,44 @@ Code InMemoryDataset$create(tbl) %>% summarize(distinct = n_distinct()) Condition - Error: - ! Error : In n_distinct(), n_distinct() with 0 arguments not supported in Arrow - Call collect() first to pull data into R. + Error in `n_distinct()`: + ! n_distinct() with 0 arguments not supported in Arrow + > Call collect() first to pull data into R. --- - Error : In n_distinct(int, lgl), Multiple arguments to n_distinct() not supported in Arrow; pulling data into R + In n_distinct(int, lgl): + i Multiple arguments to n_distinct() not supported in Arrow + > Pulling data into R + +# Expressions on aggregations + + Code + record_batch(tbl) %>% summarise(any(any(lgl))) + Condition + Warning: + In any(any(lgl)): + i aggregate within aggregate expression not supported in Arrow + > Pulling data into R + Output + # A tibble: 1 x 1 + `any(any(lgl))` + + 1 TRUE + +# Can use across() within summarise() + + Code + data.frame(x = 1, y = 2) %>% arrow_table() %>% group_by(x) %>% summarise(across( + everything())) %>% collect() + Condition + Warning: + In y: + i Expression is not a valid aggregation expression or is not supported in Arrow + > Pulling data into R + Output + # A tibble: 1 x 2 + x y + + 1 1 2 diff --git a/r/tests/testthat/helper-expectation.R b/r/tests/testthat/helper-expectation.R index 090ed36aa7f94..63d0163aa3129 100644 --- a/r/tests/testthat/helper-expectation.R +++ b/r/tests/testthat/helper-expectation.R @@ -88,7 +88,7 @@ compare_dplyr_binding <- function(expr, tbl, warning = NA, ...) { if (isTRUE(warning)) { # Special-case the simple warning: - warning <- "not supported in Arrow; pulling data into R" + warning <- "> Pulling data into R" } # Evaluate `expr` on a Table object and compare with `expected` @@ -289,3 +289,8 @@ split_vector_as_list <- function(vec) { expect_across_equal <- function(across_expr, expected, tbl) { expect_identical(expand_across(as_adq(tbl), across_expr), new_quosures(expected)) } + +expect_arrow_eval_error <- function(expr, ..., .data = example_data) { + mask <- arrow_mask(as_adq(.data)) + expect_error(arrow_eval({{ expr }}, mask), ...) +} diff --git a/r/tests/testthat/test-dataset-dplyr.R b/r/tests/testthat/test-dataset-dplyr.R index 493eac328e5cd..d5c8dc9820a88 100644 --- a/r/tests/testthat/test-dataset-dplyr.R +++ b/r/tests/testthat/test-dataset-dplyr.R @@ -323,10 +323,9 @@ test_that("head/tail on query on dataset", { test_that("dplyr method not implemented messages", { ds <- open_dataset(dataset_dir) # This one is more nuanced - expect_error( + expect_snapshot( ds %>% filter(int > 6, dbl > max(dbl)), - "Expression dbl > max(dbl) not supported in filter() in Arrow\nCall collect() first to pull data into R.", - fixed = TRUE + error = TRUE ) }) diff --git a/r/tests/testthat/test-dplyr-across.R b/r/tests/testthat/test-dplyr-across.R index 32476bab06fce..cfdad9a1f4c05 100644 --- a/r/tests/testthat/test-dplyr-across.R +++ b/r/tests/testthat/test-dplyr-across.R @@ -117,13 +117,11 @@ test_that("expand_across correctly expands quosures", { ) # ellipses (...) are a deprecated argument - expect_error( - expand_across( - as_adq(example_data), - quos(across(c(dbl, dbl2), round, digits = -1)) - ), - regexp = "`...` argument to `across()` is deprecated in dplyr and not supported in Arrow", - fixed = TRUE + # abandon_ship message offers multiple suggestions + expect_snapshot( + InMemoryDataset$create(example_data) %>% + mutate(across(c(dbl, dbl2), round, digits = -1)), + error = TRUE ) # alternative ways of specifying .fns - as a list diff --git a/r/tests/testthat/test-dplyr-collapse.R b/r/tests/testthat/test-dplyr-collapse.R index f50fa8945db11..f658c531e78b5 100644 --- a/r/tests/testthat/test-dplyr-collapse.R +++ b/r/tests/testthat/test-dplyr-collapse.R @@ -168,19 +168,6 @@ total: int64 extra: int64 (multiply_checked(total, 5)) * Sorted by lgl [asc] -See $.data for the source Arrow object", - fixed = TRUE - ) - expect_output( - print(q$.data), - "Table (query) -int: int32 -lgl: bool - -* Aggregations: -total: sum(int) -* Filter: (dbl > 2) -* Grouped by lgl See $.data for the source Arrow object", fixed = TRUE ) diff --git a/r/tests/testthat/test-dplyr-eval.R b/r/tests/testthat/test-dplyr-eval.R new file mode 100644 index 0000000000000..16c56f28cdbbf --- /dev/null +++ b/r/tests/testthat/test-dplyr-eval.R @@ -0,0 +1,60 @@ +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. + +test_that("various paths in arrow_eval", { + expect_arrow_eval_error( + assert_is(1, "character"), + class = "validation_error" + ) + expect_arrow_eval_error( + NoTaVaRiAbLe, + class = "validation_error" + ) + expect_arrow_eval_error( + match.arg("z", c("a", "b")), + class = "validation_error" + ) + expect_arrow_eval_error( + stop("something something NotImplementedError"), + class = "arrow_not_supported" + ) +}) + +test_that("try_arrow_dplyr/abandon_ship adds the right message about collect()", { + tester <- function(.data, arg) { + try_arrow_dplyr({ + if (arg == 0) { + # This one just stops and doesn't recommend calling collect() + validation_error("arg is 0") + } else if (arg == 1) { + # This one recommends calling collect() + arrow_not_supported("arg == 1") + } else { + # Because this one has an alternative suggested, it adds "Or, collect()" + arrow_not_supported( + "arg greater than 0", + body = c(">" = "Try setting arg to -1") + ) + } + }) + } + + ds <- InMemoryDataset$create(arrow_table(x = 1)) + for (i in 0:2) { + expect_snapshot(tester(ds, i), error = TRUE) + } +}) diff --git a/r/tests/testthat/test-dplyr-filter.R b/r/tests/testthat/test-dplyr-filter.R index 535bcb70c4cab..ba086133dcaf4 100644 --- a/r/tests/testthat/test-dplyr-filter.R +++ b/r/tests/testthat/test-dplyr-filter.R @@ -317,7 +317,12 @@ test_that("Filtering with unsupported functions", { filter(int > 2, pnorm(dbl) > .99) %>% collect(), tbl, - warning = "Expression pnorm\\(dbl\\) > 0.99 not supported in Arrow; pulling data into R" + warning = paste( + "In pnorm\\(dbl\\) > 0.99: ", + "i Expression not supported in Arrow", + "> Pulling data into R", + sep = "\n" + ) ) compare_dplyr_binding( .input %>% @@ -329,8 +334,10 @@ test_that("Filtering with unsupported functions", { collect(), tbl, warning = paste( - 'In nchar\\(chr, type = "bytes", allowNA = TRUE\\) == 1,', - "allowNA = TRUE not supported in Arrow; pulling data into R" + 'In nchar\\(chr, type = "bytes", allowNA = TRUE\\) == 1: ', + "i allowNA = TRUE not supported in Arrow", + "> Pulling data into R", + sep = "\n" ) ) }) @@ -468,7 +475,12 @@ test_that(".by argument", { filter(int > 2, pnorm(dbl) > .99, .by = chr) %>% collect(), tbl, - warning = "Expression pnorm\\(dbl\\) > 0.99 not supported in Arrow; pulling data into R" + warning = paste( + "In pnorm\\(dbl\\) > 0.99: ", + "i Expression not supported in Arrow", + "> Pulling data into R", + sep = "\n" + ) ) expect_error( tbl %>% diff --git a/r/tests/testthat/test-dplyr-funcs-conditional.R b/r/tests/testthat/test-dplyr-funcs-conditional.R index 3ea1853fec455..d90dc827b40d5 100644 --- a/r/tests/testthat/test-dplyr-funcs-conditional.R +++ b/r/tests/testthat/test-dplyr-funcs-conditional.R @@ -248,75 +248,50 @@ test_that("case_when()", { ) ) - # expected errors (which are caught by abandon_ship() and changed to warnings) - # TODO: Find a way to test these directly without abandon_ship() interfering - expect_error( - # no cases - expect_warning( - tbl %>% - Table$create() %>% - transmute(cw = case_when()), - "case_when" - ) - ) - expect_error( - # argument not a formula - expect_warning( - tbl %>% - Table$create() %>% - transmute(cw = case_when(TRUE ~ FALSE, TRUE)), - "case_when" - ) - ) - expect_error( - # non-logical R scalar on left side of formula - expect_warning( - tbl %>% - Table$create() %>% - transmute(cw = case_when(0L ~ FALSE, TRUE ~ FALSE)), - "case_when" - ) - ) - expect_error( + # validation errors + expect_arrow_eval_error( + case_when(), + "No cases provided", + class = "validation_error" + ) + expect_arrow_eval_error( + case_when(TRUE ~ FALSE, TRUE), + "Each argument to case_when\\(\\) must be a two-sided formula", + class = "validation_error" + ) + expect_arrow_eval_error( + case_when(0L ~ FALSE, TRUE ~ FALSE), + "Left side of each formula in case_when\\(\\) must be a logical expression", + class = "validation_error" + ) + expect_arrow_eval_error( # non-logical Arrow column reference on left side of formula - expect_warning( - tbl %>% - Table$create() %>% - transmute(cw = case_when(int ~ FALSE)), - "case_when" - ) + case_when(int ~ FALSE), + "Left side of each formula in case_when\\(\\) must be a logical expression", + class = "validation_error" ) - expect_error( - # non-logical Arrow expression on left side of formula - expect_warning( - tbl %>% - Table$create() %>% - transmute(cw = case_when(dbl + 3.14159 ~ TRUE)), - "case_when" - ) + expect_arrow_eval_error( + # non-logical Arrow column reference on left side of formula + case_when(dbl + 3.14159 ~ TRUE), + "Left side of each formula in case_when\\(\\) must be a logical expression", + class = "validation_error" ) - - expect_error( - expect_warning( - tbl %>% - arrow_table() %>% - mutate(cw = case_when(int > 5 ~ 1, .default = c(0, 1))) - ), - "`.default` must have size" + expect_arrow_eval_error( + case_when(int > 5 ~ 1, .default = c(0, 1)), + "`.default` must have size 1, not size 2", + class = "validation_error" ) - expect_warning( - tbl %>% - arrow_table() %>% - mutate(cw = case_when(int > 5 ~ 1, .ptype = integer())), - "not supported in Arrow" + expect_arrow_eval_error( + case_when(int > 5 ~ 1, .ptype = integer()), + "`case_when\\(\\)` with `.ptype` specified not supported in Arrow", + class = "arrow_not_supported" ) - expect_warning( - tbl %>% - arrow_table() %>% - mutate(cw = case_when(int > 5 ~ 1, .size = 10)), - "not supported in Arrow" + expect_arrow_eval_error( + case_when(int > 5 ~ 1, .size = 10), + "`case_when\\(\\)` with `.size` specified not supported in Arrow", + class = "arrow_not_supported" ) compare_dplyr_binding( @@ -500,9 +475,9 @@ test_that("coalesce()", { ) # no arguments - expect_error( - call_binding("coalesce"), - "At least one argument must be supplied to coalesce()", - fixed = TRUE + expect_arrow_eval_error( + coalesce(), + "At least one argument must be supplied to coalesce\\(\\)", + class = "validation_error" ) }) diff --git a/r/tests/testthat/test-dplyr-funcs-datetime.R b/r/tests/testthat/test-dplyr-funcs-datetime.R index 6f520f6e3223b..0e4d2f3656a43 100644 --- a/r/tests/testthat/test-dplyr-funcs-datetime.R +++ b/r/tests/testthat/test-dplyr-funcs-datetime.R @@ -1886,34 +1886,18 @@ test_that("`as.Date()` and `as_date()`", { ) # we do not support multiple tryFormats - # this is not a simple warning, therefore we cannot use compare_dplyr_binding() - # with `warning = TRUE` - # arrow_table test - expect_warning( - test_df %>% - arrow_table() %>% - mutate( - date_char_ymd = as.Date( - character_ymd_var, - tryFormats = c("%Y-%m-%d", "%Y/%m/%d") - ) - ) %>% - collect(), - regexp = "Consider using the lubridate specialised parsing functions" - ) - - # record batch test - expect_warning( + # Use a dataset to test the alternative suggestion message + expect_snapshot( test_df %>% - record_batch() %>% - mutate( + InMemoryDataset$create() %>% + transmute( date_char_ymd = as.Date( character_ymd_var, tryFormats = c("%Y-%m-%d", "%Y/%m/%d") ) ) %>% collect(), - regexp = "Consider using the lubridate specialised parsing functions" + error = TRUE ) # strptime does not support a partial format - Arrow returns NA, while @@ -3126,11 +3110,9 @@ test_that("timestamp round/floor/ceiling works for a minimal test", { }) test_that("timestamp round/floor/ceiling accepts period unit abbreviation", { - # test helper to ensure standard abbreviations of period names # are understood by arrow and mirror the lubridate behaviour check_period_abbreviation <- function(unit, synonyms) { - # check arrow against lubridate compare_dplyr_binding( .input %>% @@ -3255,7 +3237,6 @@ test_that("timestamp round/floor/ceil works for units: month/quarter/year", { # check helper invoked when we need to avoid the lubridate rounding bug check_date_rounding_1051_bypass <- function(data, unit, ignore_attr = TRUE, ...) { - # directly compare arrow to lubridate for floor and ceiling compare_dplyr_binding( .input %>% @@ -3288,7 +3269,6 @@ check_date_rounding_1051_bypass <- function(data, unit, ignore_attr = TRUE, ...) } test_that("date round/floor/ceil works for units: month/quarter/year", { - # these test cases are affected by lubridate issue 1051 so we bypass # lubridate::round_date() for Date objects with large rounding units # https://github.com/tidyverse/lubridate/issues/1051 @@ -3348,7 +3328,6 @@ test_that("timestamp round/floor/ceil works for week units (non-standard week_st }) check_date_week_rounding <- function(data, week_start, ignore_attr = TRUE, ...) { - # directly compare arrow to lubridate for floor and ceiling compare_dplyr_binding( .input %>% @@ -3395,7 +3374,6 @@ test_that("date round/floor/ceil works for week units (non-standard week_start)" # ceiling_date behaves identically to the lubridate version. It takes # unit as an argument to run tests separately for different rounding units check_boundary_with_unit <- function(unit, ...) { - # timestamps compare_dplyr_binding( .input %>% @@ -3464,7 +3442,6 @@ test_that("temporal round/floor/ceil period unit maxima are enforced", { # results. this test helper runs that test, skipping cases where lubridate # produces incorrect answers check_timezone_rounding_vs_lubridate <- function(data, unit) { - # esoteric lubridate bug: on windows and macOS (not linux), lubridate returns # incorrect ceiling/floor for timezoned POSIXct times (syd, adl, kat zones, # but not mar) but not utc, and not for round, and only for these two @@ -3702,8 +3679,8 @@ test_that("with_tz() and force_tz() works", { mutate(timestamps = force_tz( timestamps, "Europe/Brussels", - roll_dst = "post") - ) %>% + roll_dst = "post" + )) %>% collect(), "roll_dst` value must be 'error' or 'boundary' for nonexistent times" ) @@ -3712,11 +3689,10 @@ test_that("with_tz() and force_tz() works", { tibble::tibble(timestamps = nonexistent) %>% arrow_table() %>% mutate(timestamps = force_tz( - timestamps, - "Europe/Brussels", - roll_dst = c("boundary", "NA") - ) - ) %>% + timestamps, + "Europe/Brussels", + roll_dst = c("boundary", "NA") + )) %>% collect(), "`roll_dst` value must be 'error', 'pre', or 'post' for nonexistent times" ) diff --git a/r/tests/testthat/test-dplyr-funcs-string.R b/r/tests/testthat/test-dplyr-funcs-string.R index 039220b88ee00..cb1d4675058b6 100644 --- a/r/tests/testthat/test-dplyr-funcs-string.R +++ b/r/tests/testthat/test-dplyr-funcs-string.R @@ -172,27 +172,31 @@ test_that("paste, paste0, and str_c", { # expected errors # collapse argument not supported - expect_error( - call_binding("paste", x, y, collapse = ""), - "collapse" + expect_arrow_eval_error( + paste(chr, int, collapse = ""), + "`collapse` argument not supported in Arrow", + class = "arrow_not_supported" ) - expect_error( - call_binding("paste0", x, y, collapse = ""), - "collapse" + expect_arrow_eval_error( + paste0(chr, int, collapse = ""), + "`collapse` argument not supported in Arrow", + class = "arrow_not_supported" ) - expect_error( - call_binding("str_c", x, y, collapse = ""), - "collapse" + expect_arrow_eval_error( + str_c(chr, int, collapse = ""), + "`collapse` argument not supported in Arrow", + class = "arrow_not_supported" ) - # literal vectors of length != 1 not supported - expect_error( - call_binding("paste", x, character(0), y), - "Literal vectors of length != 1 not supported in string concatenation" + expect_arrow_eval_error( + paste(chr, character(0), int), + "Literal vectors of length != 1 in string concatenation not supported in Arrow", + class = "arrow_not_supported" ) - expect_error( - call_binding("paste", x, c(",", ";"), y), - "Literal vectors of length != 1 not supported in string concatenation" + expect_arrow_eval_error( + paste(chr, c(",", ";"), int), + "Literal vectors of length != 1 in string concatenation not supported in Arrow", + class = "arrow_not_supported" ) }) @@ -602,10 +606,15 @@ test_that("str_to_lower, str_to_upper, and str_to_title", { ) # Error checking a single function because they all use the same code path. - expect_error( - call_binding("str_to_lower", "Apache Arrow", locale = "sp"), - "Providing a value for 'locale' other than the default ('en') is not supported in Arrow", - fixed = TRUE + expect_arrow_eval_error( + str_to_lower("Apache Arrow", locale = "sp"), + paste( + "Providing a value for 'locale' other than the default ('en') not supported in Arrow", + "> To change locale, use 'Sys.setlocale()'", + sep = "\n" + ), + fixed = TRUE, + class = "arrow_not_supported" ) }) @@ -1041,14 +1050,15 @@ test_that("substr with string()", { df ) - expect_error( - call_binding("substr", "Apache Arrow", c(1, 2), 3), - "`start` must be length 1 - other lengths are not supported in Arrow" + expect_arrow_eval_error( + substr("Apache Arrow", c(1, 2), 3), + "`start` must be length 1 - other lengths not supported in Arrow", + class = "arrow_not_supported" ) - - expect_error( - call_binding("substr", "Apache Arrow", 1, c(2, 3)), - "`stop` must be length 1 - other lengths are not supported in Arrow" + expect_arrow_eval_error( + substr("Apache Arrow", 1, c(2, 3)), + "`stop` must be length 1 - other lengths not supported in Arrow", + class = "arrow_not_supported" ) }) @@ -1169,14 +1179,15 @@ test_that("str_sub", { df ) - expect_error( - call_binding("str_sub", "Apache Arrow", c(1, 2), 3), - "`start` must be length 1 - other lengths are not supported in Arrow" + expect_arrow_eval_error( + str_sub("Apache Arrow", c(1, 2), 3), + "`start` must be length 1 - other lengths not supported in Arrow", + class = "arrow_not_supported" ) - - expect_error( - call_binding("str_sub", "Apache Arrow", 1, c(2, 3)), - "`end` must be length 1 - other lengths are not supported in Arrow" + expect_arrow_eval_error( + str_sub("Apache Arrow", 1, c(2, 3)), + "`end` must be length 1 - other lengths not supported in Arrow", + class = "arrow_not_supported" ) }) diff --git a/r/tests/testthat/test-dplyr-mutate.R b/r/tests/testthat/test-dplyr-mutate.R index 71c1e52d33c1d..fa13c151b14e3 100644 --- a/r/tests/testthat/test-dplyr-mutate.R +++ b/r/tests/testthat/test-dplyr-mutate.R @@ -152,16 +152,14 @@ test_that("transmute() with unsupported arguments", { }) test_that("transmute() defuses dots arguments (ARROW-13262)", { - expect_warning( + expect_snapshot( tbl %>% Table$create() %>% transmute( a = stringr::str_c(padded_strings, padded_strings), b = stringr::str_squish(a) ) %>% - collect(), - "Expression stringr::str_squish(a) not supported in Arrow; pulling data into R", - fixed = TRUE + collect() ) }) @@ -202,10 +200,7 @@ test_that("nchar() arguments", { filter(line_lengths > 15) %>% collect(), tbl, - warning = paste0( - "In nchar\\(verses, type = \"bytes\", allowNA = TRUE\\), ", - "allowNA = TRUE not supported in Arrow; pulling data into R" - ) + warning = "allowNA = TRUE not supported in Arrow" ) }) @@ -538,7 +533,7 @@ test_that("Can't just add a vector column with mutate()", { mutate(again = 1:10), tibble::tibble(int = tbl$int, again = 1:10) ), - "In again = 1:10, only values of size one are recycled; pulling data into R" + "Recycling values of length != 1 not supported in Arrow" ) }) diff --git a/r/tests/testthat/test-dplyr-summarize.R b/r/tests/testthat/test-dplyr-summarize.R index a61ef95bee73d..95212407acf9d 100644 --- a/r/tests/testthat/test-dplyr-summarize.R +++ b/r/tests/testthat/test-dplyr-summarize.R @@ -832,28 +832,18 @@ test_that("Expressions on aggregations", { ) # Aggregates on aggregates are not supported - expect_warning( - record_batch(tbl) %>% summarise(any(any(lgl))), - paste( - "In any\\(any\\(lgl\\)\\), aggregate within aggregate expression", - "not supported in Arrow" - ) + expect_snapshot( + record_batch(tbl) %>% summarise(any(any(lgl))) ) # Check aggregates on aggregates with more complex calls expect_warning( record_batch(tbl) %>% summarise(any(any(!lgl))), - paste( - "In any\\(any\\(!lgl\\)\\), aggregate within aggregate expression", - "not supported in Arrow" - ) + "aggregate within aggregate expression not supported in Arrow" ) expect_warning( record_batch(tbl) %>% summarise(!any(any(lgl))), - paste( - "In \\!any\\(any\\(lgl\\)\\), aggregate within aggregate expression", - "not supported in Arrow" - ) + "aggregate within aggregate expression not supported in Arrow" ) }) @@ -965,7 +955,7 @@ test_that("Summarize with 0 arguments", { ) }) -test_that("Not (yet) supported: window functions", { +test_that("Not supported: window functions", { compare_dplyr_binding( .input %>% group_by(some_grouping) %>% @@ -974,10 +964,7 @@ test_that("Not (yet) supported: window functions", { ) %>% collect(), tbl, - warning = paste( - "In sum\\(\\(dbl - mean\\(dbl\\)\\)\\^2\\), aggregate within", - "aggregate expression not supported in Arrow; pulling data into R" - ) + warning = "aggregate within aggregate expression not supported in Arrow" ) compare_dplyr_binding( .input %>% @@ -987,10 +974,7 @@ test_that("Not (yet) supported: window functions", { ) %>% collect(), tbl, - warning = paste( - "In sum\\(dbl - mean\\(dbl\\)\\), aggregate within aggregate expression", - "not supported in Arrow; pulling data into R" - ) + warning = "aggregate within aggregate expression not supported in Arrow" ) compare_dplyr_binding( .input %>% @@ -1000,10 +984,7 @@ test_that("Not (yet) supported: window functions", { ) %>% collect(), tbl, - warning = paste( - "In sqrt\\(sum\\(\\(dbl - mean\\(dbl\\)\\)\\^2\\)/\\(n\\(\\) - 1L\\)\\), aggregate within", - "aggregate expression not supported in Arrow; pulling data into R" - ) + warning = "aggregate within aggregate expression not supported in Arrow" ) compare_dplyr_binding( @@ -1012,10 +993,7 @@ test_that("Not (yet) supported: window functions", { summarize(y - mean(y)) %>% collect(), data.frame(x = 1, y = 2), - warning = paste( - "Expression y - mean\\(y\\) is not a valid aggregation expression", - "or is not supported in Arrow; pulling data into R" - ) + warning = "Expression is not a valid aggregation expression or is not supported in Arrow" ) compare_dplyr_binding( @@ -1024,10 +1002,7 @@ test_that("Not (yet) supported: window functions", { summarize(y) %>% collect(), data.frame(x = 1, y = 2), - warning = paste( - "Expression y is not a valid aggregation expression", - "or is not supported in Arrow; pulling data into R" - ) + warning = "Expression is not a valid aggregation expression or is not supported in Arrow" ) # This one could possibly be supported--in mutate() @@ -1037,10 +1012,7 @@ test_that("Not (yet) supported: window functions", { summarize(x - y) %>% collect(), data.frame(x = 1, y = 2, z = 3), - warning = paste( - "Expression x - y is not a valid aggregation expression", - "or is not supported in Arrow; pulling data into R" - ) + warning = "Expression is not a valid aggregation expression or is not supported in Arrow" ) }) @@ -1274,13 +1246,12 @@ test_that("Can use across() within summarise()", { ) # across() doesn't work in summarise when input expressions evaluate to bare field references - expect_warning( + expect_snapshot( data.frame(x = 1, y = 2) %>% arrow_table() %>% group_by(x) %>% summarise(across(everything())) %>% - collect(), - regexp = "Expression y is not a valid aggregation expression or is not supported in Arrow; pulling data into R" + collect() ) }) diff --git a/r/vignettes/developers/matchsubstringoptions.png b/r/vignettes/developers/matchsubstringoptions.png deleted file mode 100644 index 2dff3c5858e09fd3c978d82a273f66113daf16e3..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 89899 zcmb@tbx<9_7w3z+LvVM3y9IX-5Zr=07k77exWL6V1eX98cM0z9?(Vkv?e4GM+yC}e zy{S_*)qQ$;dZxOj&z$~#qP{E3pdt|>K|nyD%E?NqK|nx@K|nykBf$Nu(TUL_{&#|L z5tsXc@bBA{$ExPni4*T`ERN4EkI2y@xRWtFJE97{@YGZ_5VKydw4_LtmheB8k&?U&i}Mj zl~C2^Cry!xT=M@`xifx6Q2SqA9P{SF;Qt#(pDu~AYH9!-)aCrK>w6~*gZ>*{my{Xn z<*Y(H9_@RPS1}I){=Defi!RFhtir?)1)g%z?Ey#e-Br#f?lkn8ilE#lEzCoX&+L08 zSuEc+5fGF9vvIcgKkuin%scph4@YXb>Q^qg`QrhsoDrC=+zl!*(oaj()tC_~k&$-V zZC&3S^bM`|+94~NjXgu~>GIjOy7#;c({7Lm}5uJB%wDrg4G9+h%D*^?GP9PPU} zfx7|3v3F!N%t2=yjL2p@=~K&L2j^pP|2KO~DLNz!Qp!8_l>Gk;Jug{>385b7?zE;M zClE~G?_`My|0+^W#qgJf-1&<<_&3Io^#B*l#cP*JgDByh_s&*HJ7TaP{d zf=FiD;w3LNeD!x{F3L>Nt9vlU z!>bPNlydF|YFJ6{L$Vf(cm@EOX$ z<~{FQZ6wP1`;XYLFn>NWhkSy3O~k&>dV^Zv2k}#)4(Qx)q?V;Z<48Fj+mP#c5yqUv z&e9+e_^fh+cx#2TqZ7Rvv(5xn*U+#PiR|_1g0O86$7)~ftrFk&JE?IW(?~beU91AW zeukveT zDb@Yr*Gdhs;@p9yuJ|jU-t=qNYc|9}AGU0VS|reUnzkA1TLa|9Ca7PK5QkUos_T@^ zEs=33*;61JIj~pgDPcL5;M!P(H~b8aM29oHf0v|R`BXaJ_}#(C+mN$+Q+}`cPb3{( z@{1M<>u%w=HTBycxUs?wTdp@BwNBxX2|b0Sldl1D+2oV`UgjvrcnXd@a96}pn%TV> zi;`C@rz1%{CE~eOh96B;0amX zW-hS!#Cx;t#ry*iqZ0*Q@v<-!1zV(JY~$QlTr9D;bfHJ;yPCaP^~TcQc)N>&Z8|xq z&6<3>zh$Z+(^JxAR~zW2H3;HP6z)Qizj0Q=p_-5cv)PVMEmL$&1Fxq3a$unE_FB4Qb15S*Rn=iwSpC>9}<;E^v7dP+$?g$fR^V5`=hKc#`noViBm#hEq@vGH)nd7 z!B1k;+9BiLqG6z(i!C}FNosKy{uC%Q`xJnd-=wN9gEoX{=I`=y<17eibB2_#hVKDX zNqu<17%qu3;;x>P6V%(q?)@opY9k3Pqfi$+v!tC(ab$SX)DzBty4*kR2QUua-aM;q zQTRadUB=SZH6lFTl!SWUs(DN!G0DDMF**0uA!Rck<6r_#C0}QbzKAk=-m}+xq^J1) z34q}tN9RVb>K1o_TyH_Ay^X*cUf@t$jHjDj@VO#?a8Wa?;XFZsCb!P5;bZ*2_56W(DqgL2+*Cn7_=`DhPcs`SbuuW89_WiQ1Y zryv-8_&Y;u2js@x=aLl!xw@`}&EIh$BUNt%P7|e~-sbkZPMK)33~|sJK2TktS(~ia z!AAju!G5P$#t7|A2n!9^wLrTZ$7uJD5nO4)lxBF<;9|f65fe97c zqj_7#=7o{Smn1#Cjm1A*8Jn{kGgD*)@T(_YM;ZBFlQ`13(p?rz<#2PRdxnkM9kUN8 zNo}yc|LXuV%4NKaN74WBkGfc*;>x#oQC{>;Yt>a2Ow16S*NEo}tzJbW$m+f<0dxkK zUAhcCw3$|>92kLlG~+i=D6ChCbBlyvwY6;?#6`Sr*&7Xg!{Dy5w!rW!wER zE9}~J1}&ug^pcQ)U2HxrPd$h9i%iNUB%H^Xvj;nieN^AK@2I2l#o$~}lk*HKtn(}58TnhE#?$Eg zzxgb-V?W(iLChQ5z!CrvK-cN@?kyI*!d9l#ugjEA7u})rQ}a1BncgC%yryM6h&&qdFF$K@mg8xn5R$KT#439;%v@c4s_|sZ5r|}+_dgTIBA(w zDS5pxX-{`nL+3TkU6<-KWv9~+e;FW!!egdoTj_4K{5moqEQ_0Du-EsggN(t)s&xRB zpKMXMSlOdR-*a!g&K{8q3~8B+>*qHiIdBgzZ}}tSd!OuJb9KGGnRdOOw91c3H+pZ` zd}{^V`V|wMS=SEo*=Vu?!p)+`-xL8te{lraWifUw^fVCUu)bFYUrzot7@jy><$q`< zSesULc-@35MFjqFBPC_4#>#y)CGzO9m^QOjToL)Ze;A&L|8wfb1>|=uK_3Bc%xl?l zT1}d(Z!wz{e1t#-Pi)ZbA#zzH3Q;|vv}w2BshP9O!d&yfc3Y(<|Es+@O2H^S zRsQX^a4KjUW#U51YXY%^(95rxSUMfV`r&94-E5=pT|77}=da8sG&sW9$lRQ{XnsBHxBjhj z%0dDtnQ)>AB0I1xi&!pW@;GnJ1srDRaSUg&f4J5Uku=kId2sgA!aP4nu^;f#Jq?`8 zZLFTDa?y;z;tldO78-s0K|t%uPvvLaU2B^vouAIA^$1m%h+$)dTC(cXfm7-$wh0_1iB$?468<|FYD%(-8Ieh09}Ywh#GIuu&)Y z1`$&E#RigYa?0iK#0+el*lz1ppM(9GF;EqIQ>KTU!M_(MbG5CYp82VWz}{)BfDUIE zdb!D#2@<5H^YtQloJ?x$;7qDR|3W^*d$pkII4d&xEK?K}NyESU3sql4ux&rfe8qI_ zY7F5*2hYS*T1_{1>*<{cY*T~NqhU(mVu_f8m7mC2oiXI)Q(5+m6O)I^K|FCDbv1-1 z?f43hxo~H7RKVn;Y=2na2YS{wt}f)6Yn*3c*u9292tZ%Vp6)&#c!oJ;X*h7$3vx{a zC&*aq>GZ5u<>+g&JPr9ZJkOZK{eHK7mJq|#YS-xg3-crPcq@9B*XaNup*b(Rhoa`m z334I9xYxXh@2vmJH~#XBz9s@Rx}%jJy?>{ z5BdiPXVLZg3`(SYF9)zTj)Q0ZviSR&KwBn^@lp%;=X!#ZjhGpJ>XgNs^C{w!99B+p z->hFh(5;L-{gArLW$^*<8$<8~v>=E5{e4Z`o&My5-L=v?m`9sCKh( zLloDJf~Y_)wc9x9laI2TCXa0YRlgs)V%5>=k8!kFWXFZu!O|!GDdf-6boYn6YOgV* z^=QNM26lWt*xb$3azd+O@33)|UBAN8wQh&5?F0f=hFbxRQ(*RhxmJghuDYl!TWmg# zfC~}3vHgNWtWPPb)6UK)H$1nblf}%PO694yQCuEhI^aTFGu<%tQW#9^c`qLBa4QrC znRHU`V1}@4%*_)Vr501sRzN!Dy9qiJMp{mWIrx3};HLw7*vB45(Ox)5y&HH)ZM7kH z3x_DtN}UM7ubkjhY&?SkN6!`9l0ji9vfB@?Z zBU9u;?9j^xv&)I2{7}KE)!i6aMM~!>Z_DzF;fUH(n zRHatFiuR!IJmrpNv0E2d3Mn|GA*D?1!iX2uD1f7r!d z((;m9@1OlN_8+-Jojr*%nYuo$;hVdR`}*0+NcQPwvi9==91d3kz0% zW{lZ9N)yCMP$bAPTsvpSKRdVC{hRXGF(GqD8@e3!eLTvvXUf?hyD=h^aJX3HZYs!{ zue(Nt8rg*paFE(rV$g3pra>aLR_RcAh_;%#V0ZsT3-dV16WZI-7~?<8wCO|77bo@#a_JYj>NcvhNtYmN2(_CD1CqBs zG{@d+3JX{R&5oII^Dc#H_BpNisSJO|3|K1XSLST2y+%`su~@nG18Na)VM7<7A3N{<_uyNwLrc$HJWEXH`sq0ucBkkKy% z82H7Rl3i;F4&gRh#iP~XPYFu%K&=HL zS!!Ve%D@A2Q@&3Lpy>nPU@j>+d_}F(O^b%rf`)3S*~vn9Ysyr}cefk2lgs&v!f)gy ziTFO^tN*PS#Mhl{_8QP{y9{`vjBbhm=90nl0OjD)G>z=%-w6bqEBtJ8(T*=w3M#zT~W63MudrLeNw@MGz8)yPDgv65P6WpC91)}KDoc38` z__*N8Jp`U-{xAsOnQNz_Im>no2oQx%n%!jR4>mQ+(T?A9ddowK2#!QdPGA@<^oaNn z^EAohpVyg{E5Y@MS*Bj4NH~9~$9_<}5^wmak10F3e$9h2!(eJ|-SsEtLOJ9}P6}of ztFdEAVpIrD<1k_hHWCS1J>>4hfrr(l;H#)>IvjzC zYN0=v@{Mb?4B%D}kD%n;6vX;u@$rW({NR&wbi_b%R2iG{O;8P{AS32qHwb+!W^<5*_qBV2nChmz44wwG4?AV`4xW1Rbm z!zk9<3&K})!s6b`)4`0h-WmD@d9tTfHabs~SRE;AC{E&TL(SNGU-lWSt>@a5=TJTq zP?DxZM{T`uGI~Ds%F>Un1aO9tcHcwUq8EO{j$clCYZ!fEBF0bK=R4U(FWV@Cb)|!8 zRWo4dwVGJ=V=&)k9Jya}n3F7X5^J;XTiTF37JitYNc3-NaYj+^jxV~%cQ^;GF^Uaj zU~i^tK%8{N#b7q!Q1*Nf|12TbYIrV36q|R1r`%Z4342IeXK=pKdH)gWkI)d!on%|1 znIz4NxIOMepPgx9+&?%6mHsMv zPH;+8yi8Lwx0mkdrkZ#wL^Ph)Cdt5ag;vTScJ6ro4s4f;_=ps%FJdgq+nq9i!ijM0Q8Fzo^r*_D`Fi+T=kGxxm~d^h0C!P9 zVu$ePt9aS(l}Rs=$m`5VvjkU85zlG!ZSk170E&p3_&c=8c9ZFvC@ zHw(BtHRVRgY9X5RA|ZYDiB1V1HMzj?ykiETFDl?O z=ydiDGNL-VYNQ8Lj?@n#a+LL%Xb>Ik3qR0f=VuZJh_SzFCnrbwiA`r?$ACXDf^-f> zHB7!mlwB&+_k?50;M@+~zK15Zd)XobyUcEvunCmg_+)QW*1v5am`Fw%y|pHGh>Hr0 z*04J41`Xl__;ZZ)SUxoo51nG2`FJrLs)WZ4RAs;5#r%ltJ7WCWVxl58qz%M&7)jJN zzAhj#5us=vlWU~Ib=;+)kcTB!XW)Mh$H_rfZ=b>3dkQAmC?)4Q@MD*st%m_{%S9hZ zK2H$P3M4;X%3etW`?Ilj!xgAvr>TwTo%r{8Kt5!X&O5M>!7o3(=;+rP0&Nw(nN8)N zU}ycVEs?#LUOwDIe?F(iTWrVh%9g0&UuwKwC_Ya68nX^mIiutfY!Ma~vf1>cmgCcB9eelh) zTl@7s+E*AekhJsFIF(MLH+9$VdD9hR+|$_6o6wy1blS zV|(}a{&vKjo_pT@BJ0pFn^}fEAta>g_}|mdXv6VfmT?nA0H$)kJ`_VkZi+(1eQgtnIX~ghjS+Mi1f5cBsrMIM`JO* z(}F&Nc4sIg6u>Ie!QwBA#YBEttfwgtD5(_^J8Gf)i#FYJOU2VT)g&zSm<9D$n()Z1 zR8&IOQ)!K%dwP zG)|7Xs2C2?piN_^3Dqhw^!TUgPWBPOUNqfT|Cz88%_YH zG&M|+88*nUQLf!m-E~YxKbbl6_jVo`^_6b+MI4liMdFdBOEC2@Fxjj=_^O;e`e6Z5 zWaYqurz@@4$24Py-A~UJ5_Nrbq9Y%SI>}&?8z@JW93@FNc`;Eq=B?pp6{k)auK} zs#wrAMCC4aD&v8Dd1P?B+G?%<;|+R;HT&Zmw$S4-DBn9_HUkL1)`tf8u`k~bnB@`1 z&;#gPuWg`A;az>s716`f2Q%z0J==^^Fi2}TlA7!fh7~_d5YS)XO?stJh@nqzF?2im zhh~}ylIb{gH#^^;55vKcj$NC_h8O;mQ0YzY+kS1)T#1=)pGxS{A~txWcW^Ok5@^|4 z)WnS+ob}wxtVXX`)#qK|vae>zpY(%Dww_9`+W+j65VZj3gHwdu_osIodoBXO*rv~r zl#xr7QuDv{6XB4w@{p8HsjQukjBc-J7WEI9W7^1m&)XV8AH+=rNs;kAhbVW>z;Zvh zB#B}|U~QP&3PH@eF1&mFX3YbINyGrejT%Us!L}gT(C{zc(rm8Gx;5E+V6!=srp<$c zci7~HMaqEaCl&XzHy9!X?pT$x436JUa&yv6p`p<;UjvrE(IY-&O1m~MuiMso=9Fn; zGBlHOw%>EqW6b$8wSeh8HxR+ zh2?MgWaZ?ES(Gcr7|S{wMXiyk-F*Ji?(FYRG`WAg59Zg|zYRW{)=NNp;WMkAkceX; z($a18?CdOLJ~5rV27dw*cn}a{Nb?f>EDxMp@@Mj8yANU&no;!zJt;E2E#{r}Kv2&5 zD$c35p9)lNASjaUL7}D{)|sTmz^5i~vk4gJLVQ*F$`zx;SYPP^JvIYBDtM*w#8+z~ z*ruH3IJUp)k1qMsn*`MoEuf_l_hkFX>G`plb^Od^WHTi=J~f^Wwq_C5G4Y4Wkwqya zd3lCW-@&urEB=!4H+t(Ec_j$F-d`gI#7nD@hbqo%W)YjsnR9c}OVsLj@iwo+jbfYa z^9i1o51lH1s)kCje_b5p`w}+F21EbddR7u(Bz)&RD zG}^}3>PsEN18T1m4&(%TRHyc9tq)*6ry0CcsVUCqFK}8ZKxXw7bHG>iY;C-jHaO{K zOAJ0b4)<%afc7t%Hi4X#w-1EOny!#p6S*#NodW5!2=|P`i#5$on3BIyrL6EzEpM46+P4QnXE!sRoMRx#<>v64?hNLgJ=*?jm(9=WX0=H z$DV{iTTV6oVt1MHOUwyyuH1z6o2 zwE$JZ7WVe%1x(wfQ2kK6P^xI?YkW{%nk^*EAWuA^K)ut?U+vhX zc)4TYVh%qI7N&})h2vWG@~;md0wM>-QU}Edlk*9Nl!nQ@JF*B1o-7oviOT_x!a|v>UOGN3g3lIVtiHL0-JUlOHjYPTtH+V zccjq3yu!*BzytwU2S4Y@C;n1qqnj>~;q2IPB{9=b2k^q}whF{12x{vrS@jw8SPs8# zT>tsf>1)i$UHkH$_ULWw7u29opj%v8=Kyrl=VPQ(zoZQR$F~oEOx+Ku(d9KucH`z@VKXUBVArEf^=$OmcW!R^(MKn=0C2qN;5ta>k29Fq1VlGE{wb2*V# zv{WvrsZ^_s48$;^_GDbBsS%eKJ0pyyRy)5c1~G_c5K@RRH-dXTj{^@Ym+LL(xE@r-1#)S}wB0gr;>IEC~#);Y$9fslxjf)okf?Mn!(fiGVgSj9gKovg z_!r$Rp)9rv*Zv0fMe_kWe5_3D0Gc0Y+WCD*rQWo~IxPlUn+eHJmj8~6IH*0@fEBRa9%uc~7HnFhCprW7Es$I%O z$vT%vYA*>v;oA;^zft-^-Vni^!QSk3n!l@XBqr^F<0b+WJqNo)u$@czp1ho+7>2D> z)}9q!Ip|4PvtWI5s6DAUe&EIKGW)eT*p3x$>4psKQjQ&b#Xy6jwDtnwy*zPtMiuKo z;~5-o3&wvf4hj*B2EW#V;0*H;og0Y6Q0R^HJds989e zI%N|S{{E;#4Lttoiv6OhEYb68_#zA2q@JXiSXXY+cP!IJ_&>VUCb_s6 z=e8q2W{Q6*7JzjrgwHw}Y2XCCaz!_B5?PE9nY1_9mreTK=jIz~&3fn#*MYG0m>(fx zq3Nd^%eqR~PZykKnL9nT%qpq_icLkVYXSO@*TP zmnmlLf;A%VtI(hB`m`K{39(qMS z?$ui9#D0ahQFN5x1HpXAbwKJ|SVBZ6Tfv5)8InQ;o!#s{Hym;5O<6W!K(u?5VRV&4 zO-3K&PKyDP$tV|%@8O~(zw55lI5Fp#dl^(iTA!F@j?k|0p8$hG$16Zk zBw!}!hJ3S~YwXNKY}X~{?JTTk^j~6Me*w4l_0(OFnoR-#MAyPsw;~z4Y5d-bmp;;E@O!` zMS(j_|5wIZXx*?&no!O|ML03W1`JCn%p=w==t08WeLAtPWR#dLB7(S(zF140cIW;U zjujj%dy!eqM?Uz7MpA3mTFU7~2fCNaPg!MI-#Bp$9^6P>Aza=VTAV#5fAAI-V@68k%n3CMzglM zGVuuK3s8B#p)_=Z5m#|u@{H&d)J&GoEFShi@fN6hp2!Q{ngZS~K%vou!zh#qt+NIQ zg*^PY;2Xg7(e5e7JwF&S(i}=;@il6JceRAK2|odsiKW{_B|)XTtneOQ(PqsF!*~)fLNONu zEUAP~FCynNedT|K=LA|-pC_aVJcbvv%~qR*F;x%xEQ8N#M-Iq@0UGFWi+^UGWN`uX z)+BJ?5lRqj;!+$~3Nx02BsBbL|KWU(F1wW|XRY{H%mW7H4K!RP6Pz-CrE-Ot@zVq! zj1-MYE2*!`LxJ%oMg4jF^o%QxFGY; zv`kIP+Gj{IpkpBUP{&ZbF#_}*5W?TbYDDpt`rymiFaA^wUB##JIpjM#L;ITH5ISZg zvr{V8l$PYpljXDK>ok`6tQH{g<+=ea|F+PJ+6dwPPjTxrISTnt3b?V|X_M!%d-0`; z*SO}tgu@hZIZvOo)202>_xe>meg#=}MR4wkXPZMmSD`PB@ouNm*WPysv^~bDuM;rM zjDAx(_3@oGLQqVjJDljDgH zr!)P%dZCONJognWR$K-TAO@CtM{Gbc#nlvRXTV|JIbD$w7L)L}L5fqQlZEfNS%P=B znHUhI(?oR;;{zqyT$ADaB`(KPO}A@&J9K{M@Yo2z}tHwPdc4y<7H_pxi} z(vfy+a&;Y2&y7LmJ9bO1E#6E{%vLShr$d1$=_i-lpqpdEE~dWION(bm1%5hfJ>dSm z2PaeII4UyLmg$6NP-3$ArMcYRt;exJ74iF@@$4rMih;Q01~IgR>G3_4HItcxC!}^KDKFH%Bs=f->()1oS+k1|QUlW+#F5w$p&w{Pt>3wuGgAt&tRuiL0F5>9bT`};iY5z5 zAA<^BVq&tYOV;y^rVBFca;tdm(a5{mpFz*2FBmKhjGSO{s?Bb4=A6BU>L8IGV+~Sq zoA#z}(jTgHt5~}uxS|bwu4?W_VhTLNrZpPQ$0;HsOAj|1Kd!DJyQ1q_CkEg z6te+!rwez#JErj~F-?iBq>aSwWpp=-Ci9ldYo>A_b2{;sX)#5)L9#^^e2EWSW&!e! z;F`si>uHIA_!1xE>|MKkiWdcRm?%)nq#z8?BZDqTL@0JNg>le^sFvV1lZ9%+RdVz@ z#mcm=pB8BfWeh3kH9agtU$%BEB7^=|=cHhq(^=v8!MVZptv-#0HXWY4uwtC;O)D`(vd%Zp za;;@Br9|nIg+OtwWnDW+b!|l)P$7MyK|}%9pC|q^)t1~qZSoESFikla8Ph>)0?Oa+3l6_BqO^GD z`-!bk5Wqiu3>i{3HTmr$x0su(dQs|#4|G=)HtY#IGAhn@$U-&u8kW+d>^o~vNdxC> z&uwrRFO4j3wh{=gpl_w`DsIZ9c61k7aGU2lMmV;8q}WZ7RTzzHj&#F%u~DyEE zw|82GJLLjk;Kv|ja>XkiWe9D7+qk}+dLKN7EG5%-3B2x&O-{!S_FKk<03IE`HeI%g9DMy5^j;rvOI^h2yx1_`Kls>a0L=Zl1<{m9_=w zIbZST<{!MA$Ad@ylK3Uq@jfy_wP{JmE_rXmTL~G4D6%sZH3Ty!I*SrApV@_yhK$yr z;c3{rH>zkwso@X58_h*|Plf%(hYQ@xI)(lNYn2J1jP8wFnx^enL7JyD0$ObKKhBZCr*m>D;0A zmy>e`{@{-C1X!SZEWfX}nJF2el$2<{7C$nU`~)70MdhtCz zbDZbYn_7G^sxr>yB2DK256t8%q|l5L`|1lRla92O1-Va0%IyZ0zZtHhg*CC-zv2m< zI7%X1;Q&rFw}Lyn69W9Qq^d^{gcQ`3l0}4zogS|H5)}Prsj`~^Srwc0;M?CkHU}UW z-G+a`n*^L+w!bv}r-4kc&a59kz{1)te9GUylmJ42vn;cAt`t}78q%*w!qJ}eMMme0L zXy2-T*;Zz`yur2|uII7;8LeMre}RUDGswmDEz2nOwx}^rA|cMHUsd(Nr!Hm@ILQBL z1A3QHSZL2Nk*gStWd+thx^@#VT~Zrdy1Oi=)6|a}GbJ%Ikb#dbjLZL zcg!e_?3-YNE$2<8SvFd^CDFP1IY+PV<+vw>vPPmH9BH`);j` z3H}t97)+dSVnxXEL5_*e#i1k@-rJ&}OA6!b{XV@Gzdi)qE~9aZ<^jGIS<7p9_H<7+ z3uP)`?D#oA7Dchy5_v2Uq&Kcl?d7**^Yz}|jnz{$5ggT?Zk zotG3pa64J{JjJ2y=t|LSNMK%%IN}YGMsGwS!=?mJ68jiZ$SBVxp%Ps9vPmrphv~am zWavmG=cXZE=$){?+zz}Qtg+pivH*lYTe)RwzDI<_?#_r^?-qejkf!0a<3H~@Oj22{ z3Ytr-eAwdn3N!wiLT9u}>|Eca)6|Nv*gHcObz;+~9ZlVS&yM#n81qBI_cF#Y`Z&JT zI6+{zn!Gl(3EnzeD})=AbvgVB8-ht#Ff0Fyk20`{UFsDYks~~>*F~N_rwWz7NKBIhUuBaQ{(FEeyxpI zXlwnae2+^57+@6@#kSK+yQa#Vf)jdeF7eA!IEBxLhk9`$U=JpU1>9|e4P`9pe% zf_HnDCW#hPB;~9iIGV&P>EDvIHSGptY36LCb}TRX`M1qtTLeI}9nv;sO3Ei-m;hOT z;=R9s{V-7Mja2=Sxb@+5mw}8H*-L$3X~WQR01Z{-;Vuh|xej}bdN*V4dEYsrd1f7$ zGibbl>6AE))Ncrt?YbIPr zpd(BuQ7A^yEA9w>Ko^#|KCU0?;(mIht2ydoTe#tFXL#BR7h4oe+R?i9U?Ih?H`Ozh z&Z#~U^8f(Hh5C`2wd8~#}66* z#K8S%(8A(pO9I*A4V#=b1Ra&!uRai>9_Qi=R|cJ(0eLh1g`^GM{Wn*A=vGWvCsp0o zyI9|-9Cn8~#t9O96hdCxv8rb)n>#niSN5O7|Wa_K9zMm3B*|~M1LE27F8OPl7 zJF$-gVwZrm=WTho1gq`-1NQ1t*HlqaL8QznjS+u&e9eK6c>TncVS;XDj$ju!SHZIM z>dzPF$7F<@FsDwx9YRt;>M*jY=vDAeK1`94Rb|4p4T#4oAq-&v{H$jSHm)K4nv8i7 z&>Xoqi<`IVK{c7(oHU8*(-~9j=}X0G*qCm_9LZTT99Ai&=7MiDKj0B>&?k6kcMvGH zVg7*__hudtqfvqE#mbP$R*)t*VP_V=*}Pep33|RxWl}Y+wNpw>8|kqP*ghHm=4U8$ zs4|l5K)+Kxph_r#*y+3{U?^M?GTm3sbzEJ;&|`3I#fhy=(VfB(k=`I#Zh8HnWC z#gIj3MH(7LU_yCp%bqp8eaqCj&LKSbb!L*=x6-;+{D7FEs3H3`y6_FCcIhFdnyQk; z8pN-hsAEpKDuey046Cax(R3=yfN4sINFv;Snebg$hX6Dm$I<+EfzKW|j`<%Z?xW+^ zw&Oo^>yzvo*@S|rY?pp;!*s%-mlcg%Y)2LX>0)SI4y)7#J2$cNf110SZ8`G&KeXPB zk^N7MV(*tP{~Mw`uALkW4bU9K>>wSd0%wrL>TvM-5C{LY9g*mjb^!U*6`f;D=3dTrc% zhs`r`)7;kq?(v(~8YMQNjf3sf-WG)BZSq?m{+s^-WU(~c8bF>q09JL+H{desS9jH5;UG&BttIoxc~Mf(Vr79KS7y1!Cn|61|3os| z{suUVcdz!hhC2@?jL&D8)u#*i5$^_f5Lv~pylTgbcv2P^XhgU!HhAZl&F#ra3NHvV zFI4>wt5eUwUy`yu-FK~j32Ou2mPmgztaJ+5kaa|anJVuzKKGCSKFGRt?)eg`i3j!& z2Wv$@2JRy0b7Q-A*tG0#Du7A4E5$RUwlgr{(dSaz<5Z?!-PG z=R(Z<+*EuPBfP3BjZA#bOkAsDJfEcs!Fnmw-H*2J;7zJG7Tod#|6LdUC*?;3P5ZqX zuP!fQfzzo2N^Wa-1A|lo`@$Ro8WU(R(IJO`@6{(6r3v;kLEia@uoV4rM15SsYU&pO z$v<%(a0uXJNttV-ub7u;nb`*5CA$O2G+2u4;whlP({dM$wA{bd+A*zzn$6ZGaJYV` zvD#T2WC*+3k&5>vYPyneg_)OOsX}sFAhL$KZuO~q)O__SXgJpG5;hPPo?Ks6=BInw zI;KU@B>)EG)GOC|&njg-oXUHVB;pM{B5(W@1!{6R;E11+_B~l?ae+N9HE;)o@~*u< zSsIb7Wo2W^yteP3iCg_G=k_Or^8PMd;;}VZ3TB0K70o89@Hvn6SCQdzRBH)laXW}D zV&3v+>a*>SxrR3Dg|V3&Q!I1}W{{HTPFL#qyeJy>g$d5iG~zTRpi!9JxvL?M|KQAf z3w(&nJsd^AHoo~UW5>}bzD27A@HI*%9s4SCtT^OLAjw&39S{^#YHY}EjNau3E7avuA&#b+|=e_*)Envzb`tEIg zv6{a3*=B8nFF3JjcFF09Gu+iq`qg^KpTw-vDO4uw>fw=m=M?eIdNVYfqRPwt3`=~L zTQtG`LMlD}T&zqOJF{6Rl_)v<-xQ8C*{(wtOP`uNS}ozsX;V4enm1@)?%>Q3^e7#z zAZl^G!S;4Lp2Rz3+LM-Y)VQXZnuO4fii_{F;U8(e2RG(*hWo)c-?%$cwjD4XSn&jg z9RX=@@`lQO2&U%wSRQmq0s48C?(sJuhQw0-FHMZ-z(v^U7WA*FQ%e2{);$pT}?s7TdKYv z3g^bR%dLJ4yCAP3=(!4_%(s(o z6W+q3a|5T#H{-s83z3!s#gEHwf?ZebOZe60niIZ0@xN7 z8&=7E7mu{HPr(Fim~|%_;q3wVeyfW*wN8Q{+_>G5)zi#x4(xb}Yi)-Ic}rgHOnqG| z2PRVXP0WXLlNBy8GeBNLdbUxj6ah9z8cYoE%btal61aAzpFQVeR@uWZ9wMzi zd6xiesh>#ZJr$R=Dz>Aic{RqX6LG%mzX=yLRV-ebK)sU({;a^ zjD3B&V}N)LX6F_6bw2qoy6H)gr(aLX-R#D!|1Nft``PXUh-)tR%m9BV*;ITuvu`l|z>wB5aA~2y`Aj(j}*s7w%tJ z_UzpLz;BO6hx;)RKxN>?R8(W`(w!Jj@IT0V%dWVBEm{%^O_x^(S<&E(^?men|SJhs%YS!9o&XsKQO~P5X;#YAJYE}Jj zJo&bz$I^pM>hgFawuHRrUqc#kDJ{9R8u}%JE(W*eGZ`=0O$}st?nk^5!=Ceey%-c` zg1P>_FmJ@UtS*{epi?0;UKaP0IKs51Okgd)?1w?M1z@zhGql|$wc*$o^)S=z@NlMN zzFT3;zzxQ&ILG*G&d}A&m&OQ9DHh$%`tIe347av&r|=ujH}M>E(Jq{k`DzK_FIux= z`i%u}9_AMl@^{N8nlZlbH#{}VgfnZLx%ttkd2HDRei4P+@@Bw3P4B0N-c3VNUOKco z@tDoNSC_@pC7Mw7n^o9CllqGlN5tBnQIX&x)_`cdYr zo#y_2AOo-D=b|ai#)i5ruHMopMy1E0L%9IbKoIg;hDKPn>Gq1ls)rTzqRkd13oTZs z53{!~4%8*&@%M_P-#``LQ_c#a?v_9owP2b4mqAR`UUaN!ti_nW@ea&w@fKk3#z;FW z6~CV(If9bG+KJAsWK5I<*Ok8_d}K8z#l&@kWEid+VM8(oA1d*S*B0`!!U^CW@V6)R z2N})a8xFd_Fl$gryQ|Ck2U5pc7huwumh4UCCOLo2#^fYyj8k2XkM0h3ypdF!$>-;k zK50m5@wYHD&F&4UELd8Cnr}vv5*kilRVdx^BT)i*-PXdDjOP_Z2IyTMW?d*6lrpKI z*eMd~blg<~iV0$%vLLSQKWKB|?t3pTBN9N8c5oNq>z947yIRqm{Gg?r#3DZ6{6S#B zXEcMxMip105jD;oBaNRNK_@WqC!2m#W=LzIa`|smK>O=#!AEA(32(w5Q60@z_iwdT z8Ip(C{9cEP!fYT#dL;}I1X3}hI6Z`Miy>ThqV1jF*whRm%_JN(IIOJL6lqmcs7QzJ z-QK-~@}^A^#TFe(BR2|ov=Oc7%0y5!hc$m+F9j41RL#WJBcFI$BI)EMCiA{PXyKCW zDSw;!Lo!=# z{VZXY6C0Vd)Yw!|Pi4MR__@L^pYi;w5Ixnu)Mu#H=#OA&pYN2+?8wB_BzwB4o{jzc zw1xwd2lYto$z}b!xG4Wj*U3YrEju|T5+(nfGjYZE$E8fQVKQ@+ElQG0<_fw_CYUw1 z7cS-?q;kc~e&+2`CXXx?;1@1MyB+fwdKO}52iIvppcG-yk=mHD7Ja@anJ>(BpOe#; zC?k`Bm}2>(un+h$t=iLgHJ;Gh3=?b%C&9o$e0SNd0KruN#Zu4aTka&`Scen;=|&BA^91+qJ^_Sf z(ZzEihsy8cxU9D|wfN~}ba~HciT3GDt9yVvnQFohGO32jnZL(S?LK2uW8@_?&q<&d zjzW)8ne(8|%?g~ZB}Jo+(oAm9B*YitPrDlo0PN!hFX;T1Y{ytA%}dN8koHU=;pYe5 zFMSdj)oJFZNpN5n&cER{W|wJiwgNKWbZc;H^Pk;^XAF<#R&$wCPlc-!&`z&4O%OP> zudTFU(I`F`T#^E15fYWix~n1yERcEq&7!U&x+w5eHqb%~Sr zfc~W2R9-!^XmBa1hCkwjZ8t$yexD ztwwK7^q{M!Ji34J?*aE5buR=0IxpV$gda|x=lA-2p{JPyG;POvfo8uJ&mOz`3+yjt zw3IZaXlw_34F)%Zku6uUAk(4nUljK}))?Xim14DuDJt&oGE4TkQ-4B9eidxFbiN)r zYNyPC>!vUtUOJX*BHg>s77?P;V^wSQ4n4Yi>BU0D3tt`!OV+zETJ&SSj~|G{1pewl z6+SZkNwhJ##-7RjwS0HGf|G#`%xG6g^&iCBGhu=q?92rcHZcGAE36&)CEQ3)3*K=0 zJIzFI`xShB`AX)hiY+tc+Kvvz2a21!D|x-@QF*@&X_W>-T*HpCAOwjXv4x7W5?|Mi zuN1tpY!vxk81YB%I4#mRLTGKn&}ci7 z)(R}#FJT8#N`831hd$pM_YMORo#Q_q?c1orvBI04CjK}QVk9PS|J=S$%b(SjSOD$J?Y|z#j`P@) zM%J;;mdqHzl%sSC6epMlg({=@YRc$y?XT(!Y`^AvH`k-KulzGcCnrUnoJJnH&&>|U z8F8dNsw7YXpxdd)BGi1n{@r#(<>FuoSMAA`ip&VxyTUj{8h~f2lz$U2tiY$XIjAbg zc8v~IBKi}B)KR6D{n0F2Nf{57aHStc`kl^abpZ@TO(uwsH|2W9(A0-7GcB>mTjkhW zEZ(3fWs;kAD^nMa%dqXNmB&o?^UAo-l}iNI#=9D!8OY@hC5_ov z>CS~LY}>Jl`+|QVHdp@0W;_s={3>g<_O=RI3POr?$#yiMoQ8ya3VowDfmy~f$YHog z)>I+mYBFQ6;k?-YWTd6=OEfyV6Ij3Uc@}#XiU2Nj}%aq9RPTRFbBTv~990oGL)!t(CbeoTyaA^|7TzErI=>AHgdZh z%9vgo|6JoMJ)Yp}hAO=+;5<;oqGI+k4&&CMWt^3BdipObq>gPUI5z%_bs3VM8aWpt z^c3t6oOo=zE~YV&sRL&x9s^jC&FdwIV*Dz=(%qR44!F z-9~{Wux_=E^ts?Ts(lTT{f6_hn`zZ4@Ig537F=GW(T?>^Iztp9=?Q5i4+%VB1x}w)a_9z<~)N;&IJ!*7!?vD=)jQ0vqqv* zkC)U~Hz+O|L{uzb%4ITt)A##t$oTBxA)Ha&;w{sQspjvL%mH@_>hh;TTH=My&EGE) z6zYyG`Pz?MYY1NwtO!h;0H=;_F0fPMQ&ME7?*6JY2A00P=<;Gs5~1G%5Ixef@!g86 zTjL!B^vCPVVC?ledb?++Snldr^@h8o9v}zq?fmguQ|?|h zIV=~bzEQ2)U}hWQLh7@WT7`6fm?Gg7c@%HS)4?g!TNdM2vUPiizl@ zf}#qk6IJfiTWsC4&R{r+(dj|C?U>zgnvuNI?leDI8)vb?#1C2)FqoZL8(TSkSs4_3 zy%;ittI%{747zKzU2c$)XU#X?CZ}Y{$Xvx&K*=dcpRh`qTAfTkfw9-^8jL?o#N)YU$Ig}$ zoq7&h)Jd?~s%7anq%qx8pEt)$Fx zbzj@WN{~CATT`Ex`t>d~;UnV$a7Wz^8&ZEoa3VCKfD9EuZ5AG8~q8+nKHT%uAlxrQIr;c zwUQG%_Bh5U<)-Tj)C5K8Ln7ML`tjFgbcx-}Ll_p<6=Pf34 z{i&83XNsn(*>v4guRBPF>7(oMz}wRW;wIHj1Y737FNsu++zz-d*!LDim&^AwE3=b5 z0DN3_0VtCcXn#mEpzK(rtjX|9cJStitXJ!YF^g+WQsvU`pj>|;ptr}8#Hr(*>rfK9 zETET|Px-GsCcGqJgZ)>HH+JvkCRm1a=t>VGt0%}ypiiO0XGpBklhpy+phxgG)+&c5 zJX^_jRy{KH%3^=Z@K*tU1C!|jtxk|UeuWAR6oLD3;SjW?x;A{ucH8k1Zhy48430jA zNetx=nPOMo09~x)m20Vntl;!#BQk{mwse0I%KUb67s}k(MNYoXl1WZo`b3qH!z?UM5#IzK>%vl-*2G zazp8JK`5TD@1ge&XCk1CMM7ubbgH~AqTT3@T;nW|<+~ep?vvdR)z5CWGxk`{Et%ar z(s@lzX9)LPG*SULUxT!9YIP=?LDoU@brqJfFJ#Bv<9FTO-+^EbWtd1G0?NtmsSU5n zG{7<0+!RM!Qk7gaHby#U5x;&URL{D3o>=J*zJRCC{XYu`ia5aDSoe|js~QX=-cKE! zbG@03?p(blMu}Abh?x|8-muD9 z4-F(ovzRY925!G!1*EYXfAfR4Ef}Wa^=iyVHu<#fuOgU3CS2&`gMz*IqHVL$9)&{0 zxkT~o4bi*0Do`hQO20{o8A3@?r}x*n&VjyCef5ub(LnXXSq`O7j6wR_Gg=DaGo5<# z1N|OG^&udd=i?IxMr+EpQjB&Xyy?>sv*F)k$ADiVzx=m%iixL=|M}T}V!(&>>Ca^U zK`Nh@0r3Alm;Lv?xX9oC-7L_I|4RP92Gr{0F#r7r1ky;X|DQHR{&0sSPNzuH+6=py zLV4Jl!Gz6@A4I-ylTaMh>3D9cgqQgynA&K;XSc-@ zT`Wg}?LaJ9E$Ah_SXS$m4}|JxKzj+yr>(8h8IDQ@YdBY?lWd=lrd5}7xn>Q3t)}YU zTPy$f2E@Mc`IDafgw@d?>CCzhjHKaDFG^#*0PPXx*RyIpy1VcNu#SPc?kOtgtGGWy zgHCU}w-Lr6m5S23ByyOq32g#0b#IwweuAMj7>e^}ciD3GhR`S1Rp=s(N1taCud%-c z|Fb7szG2c)AwVAEONBu@2(>L^d^OYruj?M_i%)8Ui=oP^#`AH=B0P%cCtDWXn5DV94YBsaFiqNC(D+oe#hG#yuF z1^<2Bs?YF$8omD{aRE=OaxlaoWeOOp0!uB4=l%>=cQ9LyqsLOEk!UL@Yl&FQxBD~o zkz%Z*x*V5M#&&*+eD*z@UhmRO26~&}y%WHx)ZV~6>hcdIeDU+D&_ak==bK1-8EMzE zH8pGl#dWNVtNxCJLsQ?Rh=JOV~QFY_c$PR8xDB zBZh12Pa^{Fh=TN){gV!fvk(iFwmDo$9_qxT+F$YxRTvNe;!c(?naDm*I_N0=O=pXU zg1oSp@KD-M`37;`NuX*f$*!@jRs-XU&g|cmUP`5URBNiu`>zowlY|`6?WL@Daax1_ z%3Iy9r_1ncxw1vdDL1{kpXL|bx`%g@RdCtQsZT!?Q-A$;prBU1;rU(Syb?$ADeUP? zVW+a`L`6`#ic0(CTKXcAeqKV%c=hG}3HLj0xn%3j`(+E?{=*1`rB%4*ztLXWXQ{bQlpz_`aqhAGQ-l=mpF8-ft_smF|&6jI2xY7VF#Vr*E zWq<9VWvY3=#Tk=zAC!0MV!poKKwbA;+x398J2|}x;7?7~w*MdMMlyEqXk%Asf?l}| z=x~;7y=feH`+WRhT)u!WqR@82vb()WTXL@)VKD~wr5c+8Nk5G@U5x~teu|14G~+lZ z5(&W)S)MA^n{8@2PqZ1%?X-H-{m-rL?Go>QH6`_3b@aAffW|+HUf)pQ%-<6-1g4(u z6z*>kRu`~*U1`9=vW0N<G3MR&!sIIS-PK__=<%8Y%a}FB2}#Q{rSCeQrT8;Fx0wIv{`~2}6UqxH!IAtKIL2 zUYhoVjdm3i+$Te>8k^;wBUcYlf4QvL~+*&;ZOrARTNU?~fI`h&q^qtKwz(o|-Za>ebDS}Q;2b>;Vfyorv@YM!YVIaOx>9PgWX*put z9W?!aw>L0FoD<1hScVDb#yZgzCk<@2HLF(%FR26>U7?}fc&+7sq7i$+s7kCXqYDs2 zcowAvu=rh3bP7C7@zN4uaE~uN7UOc1tY~!}ee{#x0Co> z)I!8~=>g{Rutd`}KdH$J%!=Y6lO_cbSIbWiH2ao@pi_Tj|3mda)4;SZEGhn5vPpw9 zd3tJUlef~ge^n5&P_Q&Zyj@Dwcu=mgb#Tvdz=BhB7QW9;Lib?%< zVew^rEDa-|&9(2H6$GZpyB<7%dVfpcK*v;{6P&Pb)hi>pTfiV?Drja@2Bw! zRl$G(81_em@B+l6AJ$_aN2VlQ`M!K}XlooVF4;r%6ZI57=I}!*=j-xcx$gYo*GC(i zmcV?`iLS92%vC($|Bdh8h$nd&0&>uAwrkV_;^GT|H0;6*hk@tp=OJv6XnJwPOjeZeEjATG>9k#!xX05aFwv#<9ip48Hn~N?lUH*kP z+KO`090k)Shwzb<5q{%nAz#V zN+d!di@R;NJwxF_p^fYrCl2%|jz$H*&ze}`!U(JhuHFkG)c@i^f_#~;xBib`;8E!SwWaU+F^gWd5j$%`4o~J(Y ze`Qe%uu#wcpC?5tw2b3%{r*3Q`Zccp<5}weKv$6s#s9Y`_P=m%v0SATd`bJiotgAg zLHc~T2e^GGm_qx%hf=GX@?`yg2`z(-)Njpw`=*Xu+E&dmxM@C|-Oy(e=gd(#GXo|s zwKM?W!!wWsDh{O%z;BGWx~T8)ys0p2lM1oK!=EUBGD`J3|p0?V^;~X z_P3bB?V8Vd1yPj^Ruf44=94%0zqtT+-hD93!2Y+9d6NB}_dOsv>8A?<+hLR09NUvm zL%qt(Ft@Zah6Qvee8xj_^9uV}O}qqp;l$+)M>eo@S>D&(&_9q4fEWAU-+z?zKPFhf zVM4dmcK?>tun-z*Fr|>5z_=6CXeZS-;2h5TXoP1m$>@kqs%~FVBni@)7t{k7nD%)e z;WV^L7_yWY%1=TPz`G`o8!mVMRLCALcx$atSLK|EpZkC)iIl(AUV#|c2LBTdzXX7v zJIjI!M4i;ZSJ0Rd?r*f*l?sVIdvGb_7+gFiWmn+?cMncwyZ4-gyNY~?JdA{bL}4LV z00Qt+E*9Gy8l#b3+824J{IMv%a-%ngW$DjBi`qh+z8fQPD6A@4Pf~VoJ@L8lc-;U& zhnOF9rsQRRCaDDT{N4@Enth{0+XFLt*HQ_-5pMj&Ng2$;ZqC9$OS+@Rgsn3KpVC&q zm7S(d7ae?nfREu&jg6CbdzZs4nJO+Lrh89!zcuhriu#8%#6Blr5~vXq`*vs z&1EhA*C8@wxW)A3pgCiq%(czl==z- zAI@a7UFiP;!k7d->+77sFBiV7Oa8@a{19AtW=FQilye*a(|6o{Jc(=H?`wa_+)jk+ zdqD6qLmFdoIK4?C=sRkCo3Ga*!w+jReqL+)@sQZ?6ir3WmG-J9a0J@sq0;Q@8gg-^ zE{0}EB;maJaTV~7gcK||Dy0-(M*dqep(Hrp`8&8JFeOO7os!L?u~^~VSzIm=KONh{ zn%xfdQ2Tl?yS1x5-*>};O9xb1Z(;6}Me=ywqHuEASO-QAU%iKMU)30k`lM2j{ky*~ z@awa5iZ^9Iq5xhnR9UGzx(z8Ef60Pd9;lJa*Kvp??Ha*$o&$oKnd5oQetL9Bx2QR; zZ{oeZy(X$xSxm=2Oi{?CswlY#(WpVKtGhXRcO$}uhi8j%96f}Ot)Pb-w!jvPP!LMC z442#YmGxE2n%1%~yoOp`j-YSj~SiKt5o>Ym~5+P-FG=`R^>QyeR(@MtanY5sP_{h4h7Yb8ov1jcce+{t>d= zxx@PPGv=JC2G2rDE?{#Ll)0h*@RyZcZe9w-21+L=}|yHDLn#Q82(%N21U8 zxEP&^Yy; z+pd$!Kp>UjgEggueq5U~0)C`n>3)TsPbR#k4)V)YZ*!$d&#eYZb;~T_NRD#H|EX{p z2C(6#lG-02Z^$V$gv}MO3INrGmFGvn2TWcOwA9}BC}(>sYe>+Z@5v731Eg(kiyH?iyL%fw%CO@dAFdy@|tDtO98v$v&2w} z-Ee&MUC2CkjT+*}4X5gb4NBprO+@SHw4NbZP2Ne9s^oXmeyG%&ms8i&;95WL0ZJiJ z6*p|YpG}eZJ~e(pA)?S}+LwOYE;|P*IeZpad5UXW^x(D$hra=$`lfU79&3f!BkpxU zvsyg?fRGSGIcg%7OMFNj-)l#nW3puWkC^!c?2XkvzQAK5*xx1l#_!`}~aGR|+kK_aG}uS?>`%Gu8=dVVJ1% ze_)?9+P-;T^zYPE);4#dBrTJY6B8da6c0}gz`A|oQS*Gv*5Z4UI{XAIczu(Up#df6 ztzM8iHMFX}JP;$>Z*GeyeuuhMf(ApFMnfDl*p1TRq`fE)zaHOnV?IKgl;6f=7kh^x z{b+a>2x!vK2&o=K@UNnH4UgTA2fQ)SBwekEtxI4rVTZ;b4;82YOW+_zMy!e0%OYR& z7;9KpI7}U^hc!3n)R9Dw5@uo-e8W3K3kBsm`!$K-isue!LTy#@bO#*(!)2`K7g&38 z6L!cGKxom`MS_g9~U=%cAO!cGiDnbz=2xK9GBJ_|gE9`B}+1Uow`xsW_&s0!CJoS@oJ zF3d|x>-oY>WG`QG?v15)pva*1Hs|YsXC_-mGnzstnOub3=9z#3LT7dc_gb(c?JDLM zX3qXUsV6ycTTkWd>S5Pl4F_lwdZfdm=?)0xM)FGus6QtN763>v8B6p0-AR{ciQQC1 ze!Fxzn6ODyt3ikLyFt>A5>isql^AwpbX54QtM!l8@|dq1hSo0Zv9(P|L3*9UPyz;# zC__iY6^CtIwAO`}{(HYq<%Mjb$dAaC5tXPN zEam8y-4%z>uDkw%$wa|B`YRn zdy%KcBKb2~%yxY7B!R9!x#Z5{Z2k}}5oJnexWHbjbFFT34%cMLf=BFVcN&awr{7wf z-u%e$Iaa!u4|dNP(HRrkzY9XpB-1|F{D+$}ymQflxz!;k2IViN^kbi^P~6mxzvumfgt8E8 z4yD`uH#ttSQGu1O9mMv5!QD0va57HiR z*Vu;JZN%??<`rur@jSjH9T8pIqrP+u_=%4nZKu(#40%gIGf=9gSszMwFS7@RX|zC#4FD9_tvRNn0z$M2;^{tubkaI$>f% znM4zUSTUUMM|&SOtx~5;iQ)t}iYmKOdk~klSx%BxU%z%@zeY>33}5}A(jWSF48z?; zx2GxLb#H;r-$G_EXhHtjsjkihx&477p0cza?!N&wkqjJ+t^b`z0q!gJYoCS zflGSW(ggnnyZN|X#@2!5pRrgW-nXlvpeCGmH$i-QG}Gs^8a`*zUsrB{dh3N_RR^#R7RltfJXYcCj&-SgyvY3VgCrmMc{ z7yR;KBKYP6XyY14`R6wbe^QYYk7{6!oiaGgzrVN2 zY;w~XZy5)hb>b4k+xH$rrc2|cQ-!?1imjeGGTu@h*g@`IR~iYG>YL;@tS2>OS_& z290f}BjB=ye|zkBvA$#O$57h3FJSMROo z{*ac^aH7|XIpUXO`KM7G>G^EGj;A>?Ttmkv<$#|67cS4I^ z!)LbN<>0Aio%j52iEnGVc!4g$QLwPbq zSy}_fQ5-HHXQzjXwZ3qq+rGv%x zLP$hrvofzw5W(P`BVh{rGbO5i=i$$#1Sl1xXnH4E81H5eNe0(5aYkaV(jaaC_h|on z{b7JUn=MvcFjL5>cr34bp>AG^w;@SJjn8qqy;fvcvZGS4zg zi!Fvhy0~1elFxnhCTo)|`}A`?L;WWM-G-LB7y;Q)v`^RD{1I40zN>v@A_WF({~Lcu6@&~#sZD{G8GorTmDvnB5~ZaJ-}ty1KAR!zO5X8G7bW~L2zO!9Ahje&z6X^n+_R8T z1AF8+AIu|BKrn`*z(5{CK zoFr_qDTKnN>@ki_x3vBVG+D;SphU@1<^hr1cx{glR@UpMdKJXQMm^8~g8(}3D8YmL zYFU!AeV3~q>v559R--y>ejb)Ac}bQ229~PgDBs-bAWq6G-y8?D(M+$9i(EX|UH>eH zLYwAnwQDZ&13zyisUUi$tJd^k33UsPJp`pxg?h1wcjn1IhEWtzk3RQn!b& zm7{w=a(h!kv~PInDBr=OxxgP-N@B6}=L`K7391_Je60pq=UgXVrHGQaJ*<#san1PkX;5o>p=Y>rGkT@@o3ul7Roisl=( z7ADpGzQ;~kL!+rtp-)A*^t(i8dUwVvzyUGGUwENbJ>@x#tBSfzxzh8zk#$AQL2mPw z<6z@Cy}B{gaZh>qdqu>>`-$J5h2I;+@btR0Wdgk0 znp=Uq8gEVRO7Eo6K$_3L9p3J;T)KkJ69nVxyt`|vUP<^R&F*xr$kp{}XT5T%LhL?I zaYl=|=R=V393Z(&Mva81>_#_&H9z0kX5`KHx(l!8Z`d>UVLa|5gUd0HN*uZgS>zba zq}K*%#cftB^e?KbtuCtU{TGgD-_YeHvEv?k&yy}{>H7?)&ii5G?v6dNkem?De0jWI z3RNa&Y21Vp)UT@`BjJbL}`7DQQvo|V}^ahG<%Nf$Y9`*u-`Z~Q= zQP?0ILCI}>yX*M^?rwKlj8xrzD9cZB3~?S;^5F9FQ~t+u@>4&!?-N<>Z~x=mJbOK8 z4MKN2U1~)ms_ZafuQ3FzD6V?_OuW6!Db;99DAIpUd8w5*-xS3;0o{0@Sr!qd_th<9 z-&~p{S8T%1)wWYDqxz586dt?O0O+l$*)4|F_Bqi_znHv)(;-aE z?tko!_%b)px|cOMMHbEkBXsjRrth-b7?lA+Qggv!vzcTo*N0FE7~Q*$4M-2elSkF= zF9CUS%DcD>5bml3Eq~E?Q$%X@%?@{tpYJU&QbidP)=T+XW{q&=@guVZgOXA5wmx$W zqa$-7)j)M4ax3F;nqJ&UL#1T%DP6L3XrUKmK)_}5W)Y!aucB79)i)yHCRj{KK`7dj z+0|BKp-R!J^#@iS;4m^S=OZbZP^fD8pK2XyZf50!;!5g8TEp|C>)vqJ6VSMk3oqpS z7?<<(??NrM(SPZJekcI?B~a`#*){~0jj6Fe{4Zc|U#k+@W(hg!KF>A448q&tB8R@o zBrTkkhhI|-aEo|WxMIxOMwO#B{kQoF=eC~(V82Q3Fe88anDt|z8RijMd;eB0{cZUY z^d&N240Ngh5y=2&z{!kFS1D$v}yJsL$bATi(-xa2O(`i~qDzW4$ipiTG(({Y}r) zcUs|M=92*?tXG2K!!79$#K=u((v4|HkL>sq3$PpfXeAp*@s+BC@bPg>!JFXY6)#@} zt>4b`(-toU>*<$rAp|STZ$&t;s&${`JcAM3>r;o^Jlxzg^xPJk-)&cXbi^-Egui|} zRnz`dRuw_`Qm(>sxb^mCLRqAQTz1~zB{(y1_xE5rTW30p8_0dk--gwO| zFBVm%^Wp0opGqsKxM4-YcPhQ9D>IS?%Tk5@ys-^mJrB0vD*sCi4)!!lEfr7G*BC+* z=$Vu7_UmE1CQsE=iqsnq{{FAIBF1PI&uvwN9;c#wJi~(-Ypkx|VSDvjdWteJ*1ci) zHWM+JJXWK@%*jVi; z1thk27JrP+w4w;<=-OVoZ=P8&b%Hv}Q}edB=edYHuxp!v@9w~qh5jq9q2pFF zu-@qL=^||-`R5h`=G8)XB`*}yBh&taHL_3?cSKJQh$?Kj97cTw&*L4L zmhYi0IPg8M)GyFRH-ZIZrr-0TN%&^2s9N_p@36vSM4PSA(|6zQ!$iNC{(4cVJ3j?y z&hGNT5z*t{n4He&KMea$mAEi`Ik)Dj#6tl)#FmDbQpMN6umj#@*VogEvjPq^&vXr9 zajRd`ANC>H?}>_%{wO8TV+gdM6X$hP!o2V+y*cwMO(?*_bZ`3;rB5&9(SDs_XuzE9 zqrd%UVkw(0$1mvIn>z?josTd6+~UG`v(%vRrJvwr)p5ti=mNyK4EBO$FLJqhpK%_k z!^L#rD?hZj>1_a}b-i*Z;Le6gR}U))cpq@5EDPP&3Etge>`QCBgOZpc%7GWAmm8r; zxxDd3xpd*=zZz_5cta3xOg;t+0|+8fuH%UMb&zbNPKZNe!?9*s^FhsL*sZ8J!#Y4k z-e?inufj7B;LTd;=KL#*)D&U5IHN%Nn!s^qQS6wcAL@|i~4#mT%1h+{8 z)#;*W=+COX3;ehpFBi$RH1ldKB^xt^oFq|GSyCw;d>($BiJZs!V!8ES@?Yg6NPl9N z!8UfMcw-ow3g~vYEx-x~HRs+PE`2XS59tEw==*yAgxH#D#uf6@GpS8X6i(HX`_PK3 z^W8e1RQfU6aV<=om4yS&VOr5slFEimvBzkCykAffsm~CTfk%NQQc;EospuD>MFz0k zjygg086&ow#N^RrAsa%ioUwPKD3fdydUC;sqRBnhq5qfVax z2W1#9Uw~qL!3tX8qtXTSwE4Qug1N9}Bd3O~rUWX5`+?HrI6sWK{YYyQ?si=9iJOmQ z8u(inPw4Z_ja>ln9Sv^Ci2r(~BzES6jZ!+P~&(gg~Fqa>>zm zz8&DyUG^u1?uLlTxY?*@m#_fZ#c_si1mP9H=^(n@854#lm{)X+?gqroYFB51h6&l_ ztkYpb{2-;-R;BT6Dybl`Tojm2zb%; zcXnOJHc?W+^Vj}xgt&KEcQ;+R&H}h{P~>D~ktb2`UN0~0F}u;;AvxmZnWOCg{+ZuU zMj2yx@1*Xp`IT!hc3m47LUC+s@3V6Os0{W8b@QC@Q&QuX6Ad5{v0*lPWujWMaJS!l zqAqn6P0ep-a-_*^1DH|IW%dg}1xYjdQa|pH=m%8Zq2)&T4 z&hiRv;gbO*VBwfDx&K?{ZjE7=PS0U;LZ zVg5Z`x{}NUWwlSj1T1g&1&lAA&G0Jn2M5v?e`}ytPTbztCwoYtO4)U1LAKngrvMtF z@Ly67sUJJmGget#o)977F?*48{cf#3_L<|`4zd(Jw~3Q!a`Wvl`_gB5A`wBA({6uL zoAa;Aw@26dznAQh^Rnh-@cTf7#BygVAKRHu-9Eq!$096KsnhR9E+NAm<}X}sC}YFm zsbXXPGJ{yC2Ul`xZSMi`Zz68q);z3zJ-mx5=(h_BhjYgtmQjAVZ{yU(6@UQ7@a6BX z@w3lA3M0p9p)o>#Cz0F2&}`{O$I7TG5NE40x#K9SIs`5yciJKi$L4Bkm<47`_L8>C zqd+ajx)_+S)HyhXwq@!5QiI?Whvj8bI!(%)zgR&Xifs;{9Y>=`lVMxxz5(zs6m@@H zW`)g%pst3mN6Y!$6$M>vjJ2rJJrDrk5Ye&j8#W|GC?T2mG2NFIr0div7G-IfPpHr4 z_*-U2SKjU~;NOb&k@^BNf-)35w-AWRHsQ(ShkGU36Lfmp3|d{s-Oy4ZlxNVRD1@J# zaV4|X;0CKvJTIr9Yc_`nnSC`G`f;W&Lw2+DSy$u)RkEtkYHc+jYY7vOAuLA%Sb?~E z)y|HO%)kyQP&LkgdyUop-hMh$thVb*`kjKqRbk44hwW2J0w0>h67Os1$7|H|Szy*< ziC1q-kb(+nzik!-37)<;NGe4+My}86Se(ng;zyk~d=NYDP3=$8x~Y)%%D=Axl*WFC zo>diCQS6|jK8QZ^(n@prBNC6RBd|rc>1GM=#dH737nBi^VoF#9<*|SJ zTY;8^w&7HFk-DG|vy5ja%3lJL%;AMf!-x1NJ9J%3;C!1t_rXEwBHr9??f>Qi6rr>y z1c2_GU*B~-D)41}bqSE#(4`l;Q88dM`E`Fz0v2#uCqlkhDl@b3|CkWAts)8)g%!4| zdXh&I-|ifyV?C~KFr-@4?<$|Hz}vN&%@1>qpAoA+0#w)I&?!wG851qwI^WJIL;8)F zNAl&`h@Y#Es+U;*RSu&=yQWu=`O{9dK;wnRt+jyTNHXbJcjLwzc73P;bbD zlp9Ws+vrefyI9lTOkJh3(`F#Rc80-wgecg_>z&|_3^t$8w2DdYtM(QyD<31aICXIN z{|R2FUfCN_wKY97GoEd2B;5`Tl99;OC%<^hQg0}ogJ4hCu+LUzE@${@m$9QrV2zkb{`u4<^u59Eq1(fckR8$Vt%SF zP+w*X`~BQ9iON*2-glSfNP>B@0pwn)n!Vu@%mh#ZJZS;QO zk!CMlw2g&!JF52n$5!QK{ev2MB4@9HDuvMX#hcxY{)vwzJ&PlyOX$>B-xoyDt>2Z* z{{RLQ3Iq--G(j&v3K~2S9=q*w$TMwDc03UtHLr!V`f{?vx8-OI*K+{M z*Ht3WbLE=UAPbWUjM3omwY*mIkw`XVgzM2%>Jzh5SBH!3u$uCr|5Qi~0nj5(YWi>0 zGcV|=zS_f-zxx;i@iY8Qu56dM_?7G$Yh^)7D2iCJ?mr^YKMSQ}dgn=cDm!!$K3z6i zm9Z%Qdn9{|)t7H4wKHn7^4w$Hkgc56lNRf8^{1BZzPaWpHi}TY?wC@liItwWHp4xk zU{50tpKi8<5Bev{nKu>85*)MvfI=vVGj!r&l#Uvh^Q9pOfc9<<%E$@h=SO+d?CrsM zYHD?~1I*q{0AhYlVGCM5Zj^}fAD1>8oO>xsintXNYeEv;cfqutIqE(~S>4$OSF@Zg zn(!FUwtPjvhY47b+u1v~-a~){xkQP2Nkqch)F!!J+!3&7-BoVoMj1u|-~1czh$Chv^DCTO;dXbj826sP_x{^G zM)%sg*REBos^(m?Y&4m6GNukyY93&Sy?toky1Is^&cq&*ioEH0v+@=ok+g)WhSb4gz0C@xiymzOi}hadDYr;yC3(7m%|(nag(AK_e_uaaT`|({ z;U=0NuywxQkKuC5cN?Fe{^M9(xt(970}9CPiiO3%WQwE>m(uq|{Dg(uxG1))6Pfn1ZB-l zn6_k=^b%k9XIs7)sfprCyW4*%(`l#uk43NL_Yq>iA^_zCH#==s@QdBCMCZ< zsWg^S>)Lzh%WH#CZs?P)q! zckE$UQv4YAJ#!3y>sx&c-x!@*6iOLDt)xSZ1{`sDaMbFJEhge;VExj7W<4$W7_h*= z##Brib$>|P{`%?TsEjry>-|L$`I^wS&Yj?#eOI`J$R@6C+DL`z{;kOM6rWE7o;!om zn-y)mxsXT~*kLi;$h7Sf9W56`RvnYx$3jzr#L1^`RKyrm&ZsmtaM6nW-Br$UK6Hv_TnvWdg6#JX^V0t;2NP?TelaS@!eHb z?Ss?h4=2Op^?uA^9cuIg+wy6Wp_ps{4w*ZqfaHa5=yL{Uo`z#6)yQT5%{Guj&M@C+ zq0J&iM>`$0&ptIy12nEE4QT7)V@4TbFC5t0t3=QRK|RtUJ36)D#!gsYe-ax)Ky}7zThVu}5U$KFE4}Me0Y&b0accxTN2NNyX zYk~efnbYb>@3d1lTofbGg4g{ZJWhjHUTk-o$?yO&O!h`j-Dn0{|FGiY}n$?T$23w*0?0)$0>BJus9lH%^AB}%(GX$ z%8L0ScCXZiujEqUnvVrdsGwB=@mA+-*^cTeDqQG!%d=v0LLGVChHqtTN@`BqtMh(s z&Brc9aIEXwbz2bc6VlHLq&z%mSRwBL$;uwWYp44)Ve(>gTf8~b;28Fwew3)? z7MhmJP6i&Pop2KDx}T(L0vB`#?H)#Zz+z$3a*B`*iphf?Rw!2^Nu9OE%3bZ``pulg zad04qWT%Q5Iv#@X4^pG#{%gei_NG%F<2o*ZgbfG9t3}=-!AJ-=Dt5FIgaK3m*{~Bu#)oxSvcauAr?WIq?YC;rVlHq8et#n0(h?hHy3~@S1*cPGNpP z@XwF==|%>`mJdeR456T)@`mphg7 zzsR`f15~xT;Nm`R6<=kowty#TQfuq#V*IE-IRQVGd`ewtr$vaHooDg-!7!ZF7cmF! z)AD((cw2F{RBb*c*zmn@$_6_l47lfQ9(~jYf%I?_%8c>v=3B>`lDeU4vR+62_1H-Ib>t|BAy$87L$ z&BrA$p-!kG`;`dB4Q(E!)LB~Q^$@_^_AOP*LSg5+ zK7lRrhVD};ZPQoAsLO*$D+<2F)~vzJ%69YdoG7w)=Sua3_JAxE%clxG%&E&AXbhaJjpyaXO z&j6EipdDeW4*{9Wr>r>`&JcJy%N!}_jI(T76UElQtP|VtqtD1BVzfhT{Gkqhw5lsG zQ9PBZJZpYZ^WHO7S`KWUCFOO2O)}zBu7E9K2)r9&0E+N*{B)OP$**S4e>%3q6VI|{e~><8qnxejNWNaeYd$}a>3a5s*LtLVJ$aGs{~u%&`IpCGl>z&OyUSiF)da8_=KH4mAkvJsFI+1%(zEtosF)w0u~92gqx zt|~%qe%90Of>TA1-JgI8%zxijh{ppz-Xrr;?>8a_&*R$m|4>;>FOj(7|1?vCqO92j&`Ie zcOujM4`q{Jv_V$oC-+|K6{&YQ1uHJt;f91Og^U=7xY#aRzPqvX*L8g9frfYqLRvcp zIxM$|lrtdBi0I2^&R)r+|!J$)W5RN-BSES)7CqFNXEwUs?`ax!#ANKHj)fOM_*<>M$jJ!vZk_}((Qv7i%cJL#lwrp<{U5j@)mC#N zta#1Drx2y^xmEQ`Jz80r&t?QjavKM48yj-NbtKxFx#)R;#pY0(6RQ$CB^`cHiM?Ex zj+Y`HtOt?hyg}2|6K#?mzEe<`G41hDaM1^6z16kgVWy6oB@tCOU-~3D^XuJ3Sim`r zQ(>0!#uPSDBCWG?hDhM*SaNU{ZpqKRy)z%r5*;-OvDS~euwL7HWcB_;Ih}vVZK4sG z@!W|+eyrqJh2fvbGFDaF??>*C?Hv=OcGsYb$Cw;>nT{xn30(lH1gwZXrWm#sGKy4P zeLcwCSuDVR=;aUD^j+8S@{T3#)-Dc1ph6=10A(466ZAs3^CDqW2lL7=PYU{f)QHgv z^-46kM0?X$g*dSoYW4${Cbbet@WtdN$Y{i1Dg`VQj)upjQ|eDcR$H8>fP}ki6J?KM z%f!(ZTO{CKEFrrsk>$>snYXjrujAg~=Qkv~MctK!Dd|&de5cFh?uE|-Hml3^6{sRF zwuawi^`RDv;o~*l@wWX>dQM8qc)&--F4)%2Y)iIv^4FqraIFLhK}!k zSP6RFe?4n@k4{R~5M01x@QarH!4nb9?7D7W+$LiYW$I|CQg?69)kU!6Bj#x!fUI3_ zac1#dgubr8mJ&X3Iera1E|Mx(fglBDH23X@h#w5QKf;!xiP;UpSV2Bd&XSO_t zZFP9!-cPz?E)1wMF(q^q)C2vmFf*Y9a``pn@=WkVV!wrl?H+AH zPJArN%QJT+->Iwr;^|AfNO5jhJG9&KOuqBRjX50nwL#nFXoV9ExgisgoS9g>FUk~X znMqyDTcboEeOp>;8IPTq>S?>HNCRdW&OO)jZlhBn31EE*fN5MM1-#poL=)7YwdBOe zfY+gy1j**vmT4RM&HST8+|*FI`EW(0boH&6?T4lWIJBEviTvkAFsw?AJfYm#{(4Q3 zfHJ(Xx(^!`Tyo|E#pE*^K?iP9RZ&2U(0Ng;&cYceTU^lgPMMq^?XH>wNcbZHKQB*W z*hJ`1edlc+caN@t_aSx|6|@GOKQ+;pjvfS9PzIRRW>4p&(y&n8ix!AN#41V%xx&U0 zyNgN!l?H^Z7_WKE>o)TZ?HCixI|=+Y8?TMIn?gds=1b#5pY$OKtt5nn(^?q30b|h; zY{9A6aJq5&nE}}neU&TH!ftXg)H@D1=m8V8%g*^KABbt$FS@=z&?(G8 zQ^XN`K`H+b7PTP96Lz@CFp%vjFtz5x)-T|t{rD)*alI(t#ndqEa;6}7y{B>8@L?I3 z^^sr7VlcP0xz1NcI0+KN1~le%l#PHpJtO1SOOA~t>3p#6;pFc90L1U=CybwWZn>?c zY4NgkAY46UznS3iI;<~LFV60f1j!#(sfo)?lpmY6SUZdSpg^SOW&|uCFQH9Pzv#q= zq}`94XS&&bTKql1sHdhlBnfh{>sH>fuGL0nja*vvHYyk%^l)AW>I`t&Zq21^e9d!5 z_ISCmo*aphT&@4kBcdBVJb&bVp+0mkPu|xaN)czO+JN6m=Q5N>cKl1b)M;V>4UX(*$lkLSODFRRl zRG)TTMr1om9|L*-&y-D&*sD96J=Czr<#sq1Tg^p}FkDz$%iWZbf zWOys4U^4ER7l6rNesMq|gBi4jzFD6Y@#O9z0 zG`+0^akxofvsn`fG%fyc2NTIp-kIkAm?2Y;ouxQ>kndN|{n;;$9uEUN z$kCiN+#?@DB;wnfg3tswbwO?xyrEW-KbC?HZ^03j*gW+*G178Y^&p_y^cxw!Y{Hni z!L0JSrK`G}yT>Dv?V|=parbT`tLBHx_4a#jMVli|?zu?&mpsM$PBWWtJ*DgDChwzwy(!o*h_`B= zt4(Y*F{O^#y9_!l-Yn7@OD|L+NFKGaeI8_`_RBCQ(nh1Jc>sGc+e0)(H{pI9h{1a- zdXh1amaT|qI5a4-c88dAf|)-<-?03#!KR1-FCE!OwQ<*XLj3`cM^UJ6`h8N;8d~p`SFAO36$Mt#O zrN?qwx{clo>yY^_zfnhsA#THNTl6Vg)uZQO6tC^RTg^`2^MVbYrj9afjnE9J@WEK~s#X{mnw^CR2x< zPAz6DT|&tQx%2vaR(Dn9qajg>VhcloPWaCab?=a8Tor}(wiupp*n?i3^7YQ!R|-fX z<$_wIFE5>Oe*)st`>YP*_6C#cORG}*qrH|`ucD!k^8}&ia;8=T(uRiHv37i-cM>6q zENLHtRx*N1fW@raiSw_;d<{|FB41{jT~^ZlKfJ2O-Y;eWJr-`(Jcn(q=PA8&+&>Ku z`p{}$A<3PPT@RGE;^F9h&NfBHp zH$;hLfi$XD1>)w*6DB~)aPp`9jhDZg5Q0%a_+5d+&hp!!Nu&`Fohw>I_=ePJs&nED z3*q7FoOE$n-C4?@H_?X0!ZjRf{^UGw1LZ7#+=;z;Lpa-B`c+zk%zfU-(^VIG%D>^e zLj9&`=ME`zB|))#R$pUE_H9nukQ;A<;N> zZ@7~PY ziN$gM$^7|3h%Sw$B;%@jDt|gnzIFCz4G(`orKE&M|5pK|f#uCEWc1%_ z`0I=xr2ifthM%c=|JJ|98!ff|=eHTq|62j%H`d4C|2lJd9tr(d&++|Jgu7%g>EDZY zRnc~GvHzA3F^K>F!m#@w;lTT$)H}8$6#HIvTZuIfq1yh&%}ZnYB~_tgy%$Irw=+-v z7e0)AkU+XoPtV)ln0kOZ%3`cUw;SYSL&1%_znc`*Mfpab##hmlUdj&l4~v_%BaKNq zLUHZIYm-_&r0xTpRka^#u-;CH7EUyB6CB5RoveOj_t7%%51{ zyPmLpHcJrgmfYZh)r4{T5k8$z4>_J$CrbGKAT)ydpYT&~r`MI`qAVV!C)o41loi7y za(h3Cwe#P`q=kMhDf^A;zZfWzUO)C~``=CL4Z2TIQ5u*B=jThjDlQe|!ET1jUHi6Y zZ84)1nM+Tc$PcW9IL0bUy$&AwL7S;63_R{N^16!F=Muvdh)S)bbi9lryQ)z=-j-%A zX^8LJ7G*yomy0Y*K5DVtTvLg+@QOb<{-vTJO61V*T+<_d)6guXI&Yksoa<`>&2tg-MQ=|(A_T| zyDzntle{7>-Xh@Vwc)IziS|LX3rOuwZ~F$;hWc>j@*dZUc?mZIX>+cQ@Kwku@R< zZRzN;;)V2HsFyY&93R}Es8L(=lh)$)=1I^p4X{&vm#8 zFWf->yw>d1A6tDn{nXV(Uklv|avAXiawVjqO!lK~ zK7B~Twb9)2wn74v^HBaY?%tBfA1Vw3&3O8qTnDsaPMz67%j)AoVsX(yo^ECHvIryV zg%80GNCdnI-3zxz`PscqAguVz_FbXSCy%j^U)TLC@~h64+b3Dd&Comx=!{%86mSx$ z$GuGN#5IIsWV-Pi=gU!b3P585M1|}_V=)0P7ot9%;5UgFNUk{*wiK}xnb;u}QQ@B+ zsAv>fKA{#Zpj-Fg1@^GUSG!anX|!zeYh`jI`UT2 z)1>zvS4y%CJU3r~q6&dq7A}rRt%<35?(i4+;2)r?#B|!>Ecu;H469Ty)J9hRkLf_lKVofi^v62@ND&+X1a&w~_H#v1@Vcf(}qvLc@7-ea0& z%rkPLGLIGYhAf8J{0ikOU2@oA_i%kK;<}CGsRyIVT$qWH6&^5sFvGF?2BWJH>xc`o zMqtL7--LuGbtFOH+Y=|mE&0L3dN8u(N&#-xl536i0j=Vw4{(AYjzeSF=foeFL1J^6w}x<*14mk504h=Z=2YNM9NIG z+)$<#bVv?oea(M7cSs1Lx$+mT8Srg&zf44HK)-HpYMd2qr%jRWs{)iFAUe~Ht!OjV zoMXwHa8f!0IIG7OU8>ng+=5DLJ*Z@ChtAXnZc!gVv0C#qRiE+B}? zjKrU@9x0MTPlxp;{o>dUtN&&gVNvdXW!ki&vYVAhI&wN_$vdDNHBnccXP3OM_O|$; zV?QR(nF}0ep+bNr-N$9MeR?$f_98v+uZ@KtsEQd}uBqZ(48KrgCvMg(>C`YeT5kR8U-jLP*Bt_&bnOBV>#Y0P?B#ok(ljl>&py&ME> z;6Mu<{_vDDe@I1Xmj9qgW9|DObkdm`j?e9sveULNzLo*C{i>rPFXDae-k~RZRY|1K zC*o6J6_}sL32SlD>3NwU{+d5z%pmGGqiTIh@x{}+r^_nNe1^Tu0UQ*Vp^O*d61@7} z^-s9hP4D`$HShr;K^daJmx@8oRg}uChqR5Gh1}W#7U?Xa$w}bpLZgC~?I_Fb7TFx( zeb?9lx!l5vY1iyg?-;2C1!z!#BePOvp_4msUkHAs+ZFHTaJeSC{x=t(l@b%8bcXk$ z^INKk`|Xqn;L>!J6=XYfvwpoi1w^*9pCEmjumPsO(qX+Z_6{rUB9{Yxt9(jT`Xl1&=D8UwDNWi%DsO<%e5Qvp^) zoGu4BR;3YfmEGxC4O(tigr)85g|reiRpm-iTW%GQ#hdKX?7*^qjN5N2%6G9!g{YG3 zrc}`ooK1o9kD2b|nhZ6~s8b#MqW%1LxQxid`iXriv?3gSQdq?aE92jJd>e#2hcEKWG)1)I;nOyn8a_K=eAG|DG%1 zu{}QVV?^6!pO~`g4<#MEpw2u9`QsTRpL!KqH)EbNwv4OA)YJ^wkFY+*bLxphJL+|z zJv9k3zHKPFeq?uZT?6f7qHo?GH)ISPix|R{&jnE=sV9$ff@);^4bFMZVCIjDk zouyY8ewvVTEyL>d(JCFSeIVmu?`7-XU~xc@E4UI3&#QRmNlh-U}658*&?KlKZ-Xf2@K82%m^zl59d zFk5t9XLyUZk^sBE@ohsM%IuxyPxIASMxlq>3gX`Jb9ZYw{yIbhWu}@>Xc75i`4#xo zj(*ZBtxVu>>*;4i&xR2j19?43QS~Al_We zkqD?a886Ok4>i-T&ks^#;ppN@)212Y3bI6dk}#5k=EGoG#BNycvTfzPwhB(05iKpz zt}b(+ag4a!M>t8hJKRc_0>)Bahog|e(%heW=w9}ol=RB64jScX6WmFo{XbK7Gn#oY z&j$C=_zF47U}}cZoMap-uzM_fnsdLtd4Ps@I?lh6$I6JFdLhPJgcWn2a6x-;!5UB( zG5F3xl6c#-Ok2h;J7j;JO$i|NlA?w95R$&W?};P|q~Ka;-GomO;>tp%H-4gHDPME= zUH(t3uSYmYAtq{wV_RE(WzRIEWsysm5X4khu^>fn?M_pHW%iJgyk*de$6*=VF39PJ z#2O;apEWMZf~XWSn_v5t%O+1x&GF^h6*(Chntl;7E5n(LQE{FZ=0qMI8r0~qU{WCC z*+h}eqqSpD2iLD5XS}ThjSc?xoc5){B2#qStrI!hV_r&DQP#2zBM{L40}DY!J=jpL zW;~D)X_nvgv;=+G9yRlk49iH;^f){AyamxVqz!NiMxelyl&t+$4SFNU~^r4x{#{c=l^P;V?ZL;Qm ziPH&zF)SNF;6Vru&`Mj4z$h=*+(T4FjxA>xF7_*{Nz~nR|$nMJ_ zwh&v@)06Uy79c{Prz~7np0M^)pp3yfBtOnSIoI#4BjjLPtL50n9RuZ<*vLi)3-v-b z)UUZyPmw3XJOw0^pUmv64bpHg9En2#lC>mKQ3f;0Lz9);p$q3&12MU!Cwkvn6&+L)t)4~a)m?DZ}` zep%bLtuO{tZn!i%gsVI#uV|7hqi+7;ri-*Ec*oNEm>y3k!oP?>rTy1+HGOY)Q({jU z5j1@WE(5j-NEIL0>~7_b6rfBJxxUG9SVYig5XkQi*4DmIRtG8DIBJ;O!Chphn9 z&&uYZVTzlkK=%cVAKc!*M9K`?=!QB!&E8^(=$mUMiU~fQA_keb{LTnI91^uK!dzqw zj6!4)@~6C+Qm1K(nxuBh58rA-f3b1jGHMU$d9p_IpxPKVH$CP;vuFz*#3z>F2!V!z zX>u&v)z1+^P z4B=vd<-OZy3TLf%VM9w&wp|JsRg_S12jJg9e-fIepueU0Khm<0cDdO;`h&6DIAmu) zxXbqK-D%(EDt?)S+s3X2qiE|aeq&9e#|O8%w1k(8h3W}jrV@Rw?l&u=WFcAbQqDnJka zWc90^zLF9b8DgPICa=y_LWURCT!Sb~2wCp!Li@>M7zn)XXT0BNMC;d5%v}z2O*%?F zazs^^jW;XJi2L4p%wtDX6`7PAvUIEX;;tIk?mIu+c&qj=56HfGI= z*rO44*y#J&BnYT;ywUAPdj`|iY`QQ%MYe{-F z6X&UUMy9O~gI5}k2N4R&!imz+jGNgi+MY?9@2da!*0v74Xjia(uG7+mB0^Ur&cDbB z({N?&43YHMvdKiItr`g$g?Z=@!MIGWDgdvmBCZc;cOru7uD&RnW8cT-!M1^q!_WBa z_>)q6BP~qpx6!&CHY0-2NmiUS6L&;oklykuqI)iiM&?`}!8XMlrNidmuqS&+A65Vz zRFGFo(^q}YFJMgqy;;Z1G(vidE>(RGU*PGDg6C$2_=IVOxS4be*-k~(^As*Z@{U&_ zsu29V?eLA4&QZFyS`Em7>#|D0><_Ees6;ffNOAH14gIBOdsFN+RH@eDrCj~ZNcgEM zUJGh&f%o@vOJ?(DTU~lZELNN4&eeLO$E))V$wEk4?jLjLZ*cUi@5|!z3vuk9_+0Lh zk-qHKMC16_R%>AmHO+$g1>>(MWYz=p`ZoluDdUCK)_5~YF@407;#&VFj6W|db*j6*}oz3Gq)M!soG!yu?fU^8dPn-3O z>Xi;WE$9qf;ryP<)0F?ep!`Llcn!FOT7)?GouXm_r6gz^?py1v2uny)+cFUnGp^C} zDCRwgLep-lhGSt}_#t-M?7yDa$Df$y4LFIkDzNZ;h9fsy;cHxW6hjt>sg*SO@;mH7u5-X*lT7qfs94XAo?*rsUym(>gu zV2L($rtJK$wE5~kfMm=q|AyS-sYt9buVU1N&8E%O?}?FZ2Xgn>94J&)KUr%Zbyzg7X-mKJ0{Blt19XkYK;x@e_|)8pL*3CkL1H!msacM10m1r*h=raN}6X9u+^Fkv09wf+r5D?UgjSq!KK80+f zvHov@k}G;yA;D%l+5nczFs}8W&kzN_qe^*e_6A6tHsV&c220*$fo%vsvbl|ynRkN- zz45oi=#bBvqiM|bEgEnUBKv{dUrB3G;szEyTQwT3eq{^c9g3?(v=`wtRnTI#NA9@h z6RpOK2(VCYhmAv36Kowx%!^xW9htzXCq77=B@Celm>z&j<^ES#GPVo)b)qUw0JG%- z?`(vxFT0c0?Laaf5CF}_gxo;f%KIh={H9kQ&`a+}pL{b(1-{6WxIGUvN6JlEGI?OM z^fGYL_hJ4By4z@G&r4s+fi&RkF`kOt=QR3;QjoYm=8+F&tt;~60p5IiAWdkYlQ*Ott$XCC%xk_S~3O@9+NF4Rb7uwIhlz>-f5@Ku;qmH|U1& zu>}J0_Ht>9fk$kn262QpSf9no5`V=aM>-(-KBYodP!LKe z-Q~{%D6^en39s23C;AVK86}$J{_q`ApG+!s{JZ@>!2IOUh=5YDU9M^md{B&X3eb@^ z&Oqpt6<1K|=k7p>$GIE8fAt~Rd!vW*tL^~K9js3-`7B;PC0t^d_{C@tV{rLXE*S}Z zqtzk!_wNSo{ZE7;O^y7Yxc1xs4?(=o_5Z6$*grxD4leindPWNS-ml@-VM`PiiD2{? zqiQ>Q2}cE+ciiuUAWhhW6$%z{_du!qz1gk6)KW9MZ4U%&)+?_~h_t`1)HQ=V9=dQ2 z8P3fKcELXEU4858Ku}&c3jRcA6f%f1PE@Zt>Tmk@4kyGHu)zP8?!``!*VV(%L=XMOB5E0XsxS%>y@hbxY9A{TB~u8-+uy7vfKa2@VR_^jVC4F{xes0 z@a*5&VR$itH{~_yGI`@Wb(4Ac>F-VtA3xL4D)VGK;f0s?j$HL@Ifw@1hI&KCc#$e~HL(K;KFe>8-3O>(K}Q@xKiXuq6l)j^ zlXe{ThF72YvXk(DyRZi0mcY*D@i;JexaLH?LK%p1K)5~NA#SC?g8EkG_Go#eJBeSw zTMJ+%SwI;O$rY}Yw%^XDi*XfVF=7Pq);UueY*fqTc8dhv>0Pbd+UWz8!0nH`YWR<; zz0Ja={;N}Kig%^>(?AUqP1g0TxJU7$>7U3!{z+E|71B4%6gp0O#EYCi{$0ESZ@b+X z(2&}UqcP?}Pbnw6b&l`cJbAv7V#`qUulvM#s}{2XXH7V`h8E;somkpp^~QoSCKF3F za>~4R`EJGtg)g~7UuULPzEdHX(eFtr@D62%%vc8QzvP^?mu~Af5pKx-y5k}T<4PZP z-8}3^C+%D|7HDuORb8ekZD!Z=VZ-I-HrI=b?OsgEL~m9V`v#(106~1uW0+xg=Tk>U zTb1}`qt>l*SD;)pEx^vO4B!}lm=cd0H=wkqCDP$xO z^8F`E6+%7EP&bboRd8kB*V!~)wq}}F9NWX-F3P(N2eG+a-vN@hY^%=aTEV+^m4B@J z^GnXg*0y7*HpTlKQw(E>IWfw#0$5xuH7{B^`y=^C5;iAgACiSRNgBgP)-zVTin$dy zL;?_ghZr#GIN=xUNKNNHMpqvK0sMm%+y>fCW(*9?&Hc?XO}7O~3esfVvR{o_!}@)Y zF|?}rx1aBw7OZ=wstIFHRjEOr^sryY6`~@SqzlsK>oMVE@o+o@H-$iZ z0l7uPfuCOwvU=6<2)7W2>MSSTN%f~ZzMD<-B!{q=q8v^Nm7_m2a&~qhw5#iGN07!N z8G_b_S$U@+v^_-}@m8zbzms4XdjehP{_*q@zc=0+oR6X<{(-v)D3*wBrmyy-xjpSh_pB{~#)}(-x8-nABy&BzDj;mqp5KQ=S&$ zp6a;CnrGcsKGY9brasvbrT_O8DnPNB&C0T)jflDljio5N8+r-=D02RL%& z*du$<=cVES?Q%9vhfeTB#ZqCcwU+W{5~6BvDhI|4#N{gN|6r~P0p-aKK|oSuHU>vLP%r2jb!M@K`Set6J9euU~_F; z4iqcMZa=85syl)ledgr~+FEuhAkxtaVmRt`h$YbNU>t`AWxPt&jg7*}x-M*=9%-LZ zE)IXCNt{J$6*`-TR=(>u;+sY+a83hO*y`8>RPCrQ?wQEdqN(Qu_^5ImVFY{xFh!l5 z``8`>N&Lf$3e%CFR~`XugT@UX7W?IGuDR#3wY7%NGq&l%mP$Q6y{~vJ^h@qnv|QO0 zjR&(C2!FRlitA|w?TAkPI)D6A?w;u3GwO@^kL{BqIXI$zl|J6EA(=u>p{8n8$@vm| zY*KGX!Oc&dwb?Nf0gN1qWS}>WiKUi;!o<r@mG%or9u!l@M6Ui=9P7$%tRxPSeOwHO>oXBUH zXAgymZ!cXL8Q2gE9-udw2t3T^z6Z<(Cc}9gCTTip81$*D!yq4--sDH}O?NBNEN`Tv z&igP0j%+@y5?MZJghQoFYALPnWne34AH_jBg8^j8C<@iA}g&iaNtZQJ}?mCLs>FaJGOX-WO#W7$8p&AA%ru1z8tH$X2;Q) zsM(+x%XJ?_jMWsWxTMwQi|^haME)^2GBAmQqtbVzTgmI{z0o!%kB^V$5U-by+fG&_ zc|-ckbU3v?aqrCRsNJ4-hJ?vbaEYr1aKwUa%HIYtMw)yNnTgTw4-P`JC5qy z%OA;C7wkK=)`c68VY~8e93)6R+C~aufn=c*n=C+J==lzf5>?We#`%tpxh7_t=Qq)j z{A|}wO(K%^@|VXk;i~kTIlz!A{qJl&t2!zp%tGqQ4F9p9{SN$kljqXz5*>aHZ&O@pe<7gGghV4fm8W8N+P|R+%U<_7 z#y1WP@7O$-yU$oQIjV@tahl9ROh^FoVIzZ_vxaADM~ILw_!`lyefP1NQz*PQ+!5_S_d`_s{@4r*``kEBT|Pwr7v z8Qs>xy5t-Vq5E3K9l?k3Tdh9g*W>xA_Kgdx=H-)X4tJEH1K&#eQNv0mi(=xba8$Jq zXKuro0(iM5ohiIvRP7aGXo^U7x;|D%E0sH;c&6UOim>`+sLgClyLKM}jjwFhdVn!( zVKmd9<(>WUHxgqJo8g=|FzWd?ocbKWvmVev^Ix1EvTVx#rsR-||A&$jpZ6c8&xrDW zm_A==|HJfQ$NUe|2QL!rMzbYJB(3Bf{EwvDcxhIWCgjlW2UpqcY&o z6|oRze4OM%^!%^0dxL*HRqWXu^tON!+9XhVke1U~7=&B5QHTL{Q}gW3-3dp7?LN2> z<}_AB7B`CoEdZRZMqj2ROP7$Hy3a`{(=~4GbbpLqQnS^^es^TXuG{OGE`w#htIMaQ zTdc*GS?h>fCSm#E$%I|55jV+zgM9h4y~av&QZQhntr;-fxng38(#_uYT_Q8*0TIu>WGd2(Tl-OmJD+MEJ@S`~27CpOC-QT-Z9gabKdMaE*y@jU zS}jfAt~lu|f9TH&kzf%79y=3${S}sHhFTR9Qjfi-Z7sQKjKAMcx|RTzn#P|FkF75q38&Mr_L)PA3KjG;i^L7m&EqKG)ke zoTIYxn)qfliBGIzmQpy?*6f-ot!%=cI~|pw75jE^9;@QWoe)tH1M~~*E7}Wa zj0ZG}I9=aW1|QO^Is~>^v8xvub>|XPy+t{kw^KsL4ekg63|bT#7DNwT3QNKM7W_QS zu_jZFCwGtWv`EHqAyD+}Ws{!%1Zin$3jB3{G|khaiDC~=SakfUS=KeDNZ)qCZhvC} zO+!X)N$?^%-!p)8_pkd3O6l@hQJe8}#uNj4uR=<*(IGE z)*NBg9=TkuNxLUk)S5J1ys}^xXYxfFktfdaZP$R3n*M0RNPVYNPl6{)+4Oynb=2T+I{H-;hJdZU< z7_MIT5o|fTdTrD z=Fn4VFJ(8;M_JzI?5*Bxi54fkxkmcseXX7ugp})v1n;0abID@3TfSPB|o*_F(WgH<5%^H9={52S&NFi!T#84p%VH5bU#dD3EtlMtUGZJeuP z%%v#cn0Gh&TSr`&;UmDV*fwr2V z;q&DtK6|kOE#PqeQSSL2nZ9X9t)7A+kRVVfayC#Ia=PNP9$f4o=k0zi7M|9fY`Y`h z5mvP&EuXoNg??{b!4-tPzJwa@O!Gv}iN_uP>*J@iC_XBYb*<}?-=WtlktvYxVSd{_QLU-YG-KUo3Aa#=y~}F5DclLHxc?Ch*<%0t$&$tat5qirzFM=!lk7&%x%%gK+e@9WH5u*Dw7&*!VR))Q$pn5p> zLZs9J~pndN(o?t>jo!5gNewXMZH2p=z7B z>(k#bwC>r7U}M}}Z%rzj^mU@z0o(*{>P&-75>P}5b4weoqe!J&wltMqfmn10cRJlE zii^o5D0A~!Xp^2^(aUDqZw)@(N5qAmS9Gv{u73!O4r75+EImelk38DH%E>9pF@#zU z8HrF;g%YPcxZeK?^JJg`7RRb_=rl5o9BW~x8ae5=g;kRH_NLLyF9mlZv z_I~Lt8pOg(*^AJu9cC>=)VFS|4RgSXyCa*f`wT^Ctdf%>bjdG$+I?d}Jmnti=MS^+_ zGB8p%;~&ZeQn{TdOt@XUX{#;m%?4+HKgFZT_@B08D+MDwuK-zGhYqG*%YKDvtVX`y zZv(R6p7iOzNAPiy(|wt-=$|G<;kO{tj!CT+c|jv(iXoNq669B`CzGVR8BE{!^Qnzo zC!uI}aXeN0Lg?|Zg}0)1>LMzkwem0GLdKrV!wk=Ev^kb8IhR&KJq>g0S;8- z12PQmCwbG1IX;j9uXSb!Ni(BWQZeDYx85C3V^1OS5Tw->j-bxDwb)6SxPAwW`W>8x zKMBgl#V@yXJFF#EiK2Zv!D0=svDjSyDavxq-hB?=`_hr5*5(_WN^(ha#~eyH=tFge&rM9>|=Svx znv+us{I8@>Zlh(}v5YxWh#|S2w|DN(&4q!=r=xJcWu5!7=@1JLo)yEI#}v6^D>)#+PI_w=h-2mmm(Mo{DA~ z$>+_Mw%9&j(ulHbff2BFPAUvpt|r6or^VnUd;WFO%Zc_-w66=gVa}&z>4>!~A=q3V zq8s+>Yn`R4qg4*Uq3}K%l5jNNyDJeoK+70~%#X1I28PgtUHC5xbhdS1|KlVbs(7ks zzDzta7g!+v)F~WaTWJsaAJn~7a2!0-H5kXtF*7qWW9-NW{R1aIp&yQ%*@Qp z%rv&gjK81feZQ}2FZN=qwrXp2In$*Xsah=^srwweR7SHtA};&#>8N+MA&{>wMoo#x z7~?$caR}o*YUq8aJ(oh?WC_8ZxVLcdy4;V@OB0}n*(RZ2lz2-*T~AV+xLrRR4)u}^ z6dLbhahPj}o+^{k%4ucRPio;xq`mZo5>&b08RdcmS}9bSJ)_xkUOb)*gM*TAx^W5V zt$|e29VuKn>j$?zO8qIPgQ=Bp1<>dngxL&aU2rP>M#dE9Y;=E46+njrrG8550ff-D zmcJPITQP?i+rT4e2+K1Nhw@|{Y;;kM9vt&||LV_lvzTO6{;}Kq_TVa3J9ZEzLb@2n z%|3wQvm+xZx~izC3t0;euW~ zr}OmwR{J!rub!Vgp`jrY;10>d;{RYj5o3E)h_}?g8h?eXDG%{M>HrY-ni^5xX4>w{Tr>@am+l>!xXKN@1-c@%jpVlL^aAWMU{Plrf3m8yG{<;CKJ*P4h4A9`e%5 z?ap#fcM&+7F+b+C{ZKlQZTV1Z);K$`Grz#}|GQ}J3?}nws;(?OM_H zQ>ft<7trI@N3}J)%ysE9qJL55kK`_RRk}D@k|HydX3BV-`AtN%(0AfOb<~3TXrxY- zf~D2Fj@dHn1NXtCXuUz zKl!<2`JiM3%ZGc`6JM_iWMJx4ZMNTG^AN=qaq_Jk3rIENM+{n1Bkek)Yd?A=ICvsz z6aOsBxRm~A-Zl0_Y%(}YwtFlbL*%t16ftS@^ZgJpW=DnSpdJYJK6o8|xN_1)$V3lr z<~R9!t{0RfYihM@^>a&Ta=b+;k9>C9g{q%3Wh@IRT#WAid;pz`C}0!xWHxJzWHOL+ z*T0bYb1fmn&op;;OLRgc{TbMCscg(`xu|(--V~3FHNKyku~(YQldW1E{rP{xF^R$Nx3)Kj6_hiiIn5$BK=^6!_fBS=_XV)h4%GOkFfbixo*`fJM zXgYRO#d3Ckj>VcAEgCBB+xTm2IqJLXr9*ZwxNG+%n%KQg(wVBM);e7R> ze9>oL7OTN5nUkoQhR#8E?+U8EEAf;KWxHxcl(M{3z#-hpRYrg34g1tb9Z}d@S-Z!y zW6d#uC<};BrLOSF~?(9){b8hQWED$~3hP2UdxNLVnB6`TANSB)A z^Q`7pmG7#hvJX4bT3#0SNKj!@A5AQoG&%pq_!W&p%zMV(>(L)f3(%$c8tHdS(6?ew z=_TUroNa~X8p@pG;)eNEbDZmKX1alcA2$l(gV6eR5<;FIAGG_fD-(~OeZd31mZRR< zQVqU2CQC?IBket$2zYeKsl0-p&D4DuBH?RE@qM&L@x=Ky{c-qkt7wah9VAlis|ZnM;X$!Smx=4D}T=BsvZtEhtGpzc#wyz5{(mgK{Tt z&ccXa`6_*Pc|B)AV=DcJIge_1qw-W-%ym9!r;C537BnZ0S)8We5!q%9W7yhUh`$qH zqFDzWB_}$Ml|?^UOMCbxNL4in6}Hxes%S9^sl@ztzQp-*`sv++A)NDfpRP6j0BC1C7VeyIjso4%*b zsK`-yx|K{TMy$1;myxv35BhUHh^T#!Mw`N`>~Q%Jxu5T~8FMbP)VE%8D& zSU}Uc>BITIs}aFRb3gmXlFS%Fwh@g!eT(4h8|@C3dgw!&_dx5Mg5=$bQr`}HzP#U1 z&7z&s#OIVmud+G%45Qs)w##f}SaN4Em@r*`+dF-kv%F;V%~?+_b}2*q_A8N6hpP7C zw2$qnotM$y38bayG>jDWz%{#3t%xi7L7$Zk0!y|+F!s7lgvM<%g881jWu{sK8FsY0 zSbA&w#L4kWr_dtx4d}}ng)u}b=`~$Yc?Sel>E-Brz+E$uf1loxoq^F1Oe72DWqw*q zrhg=baRFM3Gs$-Lq%+m+f(T^p@`QtAxm6vaCW%wEE5qt-CuCuQL)xcv0Z9~7+F zR0=)yfCX#q55$7Z)~loD&T;-vsao!p!l^^A4o z@OT?q${Zkz;9dm^^wx-Yd*{=Ntmk!whxRf>LGI^8$*|Tvr~)|AQ`%dac~iH)85l&+ zw6!)ojD^aGNgEoqqnzOddUO)72HbH~{0^Qj3VgaTWBV?82=LtF#f-I*?SYTPzFLS~ zZ-6&mJ~U7UG!-~6VOYO-us7(SpPygU=&p1p7!{qc84>2HjU}D-{+d3!sDWTIdhXf1 zeLIA9Jzwu#rj578WsA0X;OHJ5NEXGu*>LgZozh#q{7%k?`45Mu~Y69Ve{3pUP|oQ;W=3b5QH zwj822>Tfz?E}$ez91PspJLWWJXp(j@7+htj$X-a^O~smR1F}x0e?MAC^4F1auvsx) z)RX0vPhFBTeX4}J#a>R+=G+XHp*m#Izn$v;T(Sv>XK6xzaotiF^7Q_f7cbHlUtSo;kDf8RM|3W7FN@S*s0ySK@2T{Pjk<8VPifw{PRU#Btk*vxwS98cD4i~_ zd;k~yn^%Du#iu7Wod`;0gjqCE7MsuAjXB+&j>4<#W^4%NyX?mww ze>X+Yvhu(Q^}HvilO|R_qZ0U_-Nqmnf%kNgX0d%`26`0V@MItj8$}9u*9BRXu#F|w zLcF`9;G4Mhu0QZ-{N0ueFGW7jr&Hhbj$rCOEY;^>EamKh=dQZ_l=eON^N8PO0h>0~ zV0Hzad_Af5Tk-QIyD%yy(@Z36y4%?t<5K}#v1=>U`&=(Biw92eq=4yIbzr#BM5q|# zSR4$%OReSV$t5fhDiWX3Hh!QT^8$aF?tcF=wwT-Vbs5WQYX4H#1Ac!O(b z`EUfV9O)xMI5_4vaQNjhMuWVwnA32s=;dP-_BF1XDN&e&cGBcho z6!CD=p^h?d=s0b!Z)TZ78qYvdf??In$MMowq?x{pK7Qj&T=ExAGap&jYoX*1 z0FGCFvrI2pyZBcClUBE5j-H=jV3icrbB9`tw+Gzbnm6<3`6%3bQIz@Yb6h|6&Xp3p zV=ejN%{YCB6dIrept(v6{jH5BbOKsCp6BS@u!X9&BRiiFkYJl9C){a7}UPDXu>uHu&Jz{}kd@av@aW}-@3408D% z$M!k5Z{K4c2)T$W3|^a^>D(e3jOLFJsnhxJS|XPU9{wEea|04op!dKCbSI!@ihfYT zm%IxvM>EK1IH%tTKur%X!oaXmHQ64NN$9k?!uRq?s5)X*OUF+7b7vARRdMRbM|@Sc zubzpC9d$P>`OEFaRiyKVAN0|fY(%+MEv>Q;Hns5k5{NY<3SB16ate*{osVeTgH0Xy z-ZS;GNBuTq#?Ay3YqW;EvRTPB6_YvP>P3f4{-Is&ww(y4Q7h3C*G1?u`gfh*DFp`6 z5c#z~=H@nOrbI&{9?32lA*Ni8&!xMH@R&r6fF+NXU|N_oDA4Db zovU_1-s&w8(pV`KkFPOuLhy5_r;-MxCDDZs$S)LY&5v~*x>$FaMHT&gU!ZW(Zai@) zw(Yb=y@_y|t`P9rxORON+NKcW)Q*2UYuw1+tJ8Z*5MU^pEZz1#!p>7j-MEAzu_^V+# zy;p8fPj9pKLdRP@`gr8ijjZQ-R4%5qjOLA3a46oHFfej{}} z&6IA5QLisRpr}l>_i0(%6FFZ}d7P3^4=V5Ou+>8gql0-fjZeK3m=egHTVUZzYj;f0C&i${41@B+H z0lD!)uh^9=nvLvtV0*Xp;o^&SJGy_yRAvATuGsx%(G?3ne;HOw&Mo>4&G??|$*|fq zJjWrf+GU2GJ|CPdBz&TZ&+E#}3d#V!yf>+OmF{*O1zIq?nU8mc6lFx}cppHzGv=!p z9KWtO%l7`?e2V_WKN`&*CvdPxo9IlB?sS%%LS^V4gH}0A%2n;uio{}Qnl8N~D5$$= zId2d;kw@oE;7^8`RJn45a&OurCxC`5VP2DGo+oQj54lXKL;RJRruD-`9Xzdp@FN&O zI|{cERAV^@ddrwy^fBv0!(%qjC&Euocl8#BLwbeh{3OQ1I71U~K??YSHa~w5O$e!l zo1dBY7S1{h{zzd=k%OPXsC zfBQJ>WF1-N@{R?_RVHzv$x*s-qQ#iD7cTEUa*3T;wUt`!7woQMY#7v)9k9vh!bv5- z^Odf)R=lEk!&_r5SK%{}DT9U1q#4TsvP4-{Y~p9sOazZR??l<;{>TFA%+1z8C)5hq zdF1qQc7iwCJ9E0wW56g)0Oi>LhWDlm<_-og=qXGX&di}lmv16KE|5E}9-@{-oShHc zflPjR8sRL~lru{{0f&o5qqeS6}1H%}_-*-9M7%2`>6`s_F65NW4ji45{aN(^Sv z(LLtT`qH_UuebfDs^g{@)i2@Za<%|E?xS7TuSwjg;z%s(|{VDz@7l0*&8=o0FhhHK_F60QJ3Xa$3 zH07}GB}6=n1qnfp-@#Iui`9cVZZoU_i$*Piu;cOsU9cL~q@_M#CQp1f>Fau=4?f(o zrd&coqH4OYtKgbq&RhXEb`6!kd!h~E4+g;ybwEI3FNgjWNs>wIhu1t+&TM!( z%P5qI9vT(owt#{}GV`5&LH;F8`nKX|Qj*Cat#=sR`W2h#XcA1SETyBi9$2aYDQ|7> z8x|VuEPTD)lM}!w+cBKa`0W6Xdc%#ED7wzNn~qToW2Aa9_}jb zKhRBeFz5l=XTGj_t%0jD0-uBDGKBOH>_qQE@g!k-ZkvOnBg^5XMCfZxe|lL5M@wXs zl1H~D7btE|#rW0YoLC=@yB#xciBHPJNN;~$f@EFAg=0t@E) z;D&`ae=i~+m`?~Rkz>VL8$Cs(BfKHh`7I?XGWo$w6)xj2Q{%=v$a4x+%qaX2Is*e3 z#s-R(QJqJyG0M?qu!N{1t`lbK!4EFG+dK5|h}G8I`2*1|Ot84Loi+YG56B48kaxm$Qn%j?1~niKx8I@wy#tI_U2@8GH|zM}-q=E&eb zadb*U?;aH|Ys;Y$`G5?qX{JtQPejQXGn2bYz z(YYgF@Ebt^g@A*{O6y&bMmSe7EwVV7xGag%4LGvaS@V$sXui<(+Jk<>BdOVu()C=v zP`e3t{}&iTfKbyVRpSq}5Z6-CoPAODE!M>6`QqF5`W4??Ke;!$Ip0V>92}$v&C-1u zg(#Ur=F2pvL?OR-i4Vt?Q-|R!#HM;nmVsfD}MN@~mH8 zMrUHyYH@qVe^7$_mXb*lROsF^=Ly6=x-8qLOG3`(2$&XXbl|3MF|B|2^GDC=xv@0p z@=#;4C@mg{GvdR8)H0k%P?g&jxBI<4eA`FD{i?#}q%J`Ke!T_b-5n-+*I)iR%N$G2 zk(Y8{v>1RdWYk+}?r`&-t5#L@OVS$wxf#Wv`*T+vOPzqtR>G{~E znVqR1;WytumUe7rCWxu@_T`TxF^Or6r{V-oCgZ0k;>iydjN`Qtp0x#H^SOROoH)bb zI~rC3@Dxekk?RR^Riuix#2KDeJSs`RateI%0(9k!2jw70vcRW?JDD*WIE+aM%D;{2 zq*@#}ZGLqxMadFM-4#Hw;vS0CY1-+CcV-L3_i!qR?HYbMi)}LOa0~M>%VjzI$fZ`( zRVmeKLo60Tus1A>fkB zCOv@RJ-bWHYPFM}F@(%zn@7Q$3YN+-6l_kPawO$G@OBUnh|TTG0APy|-JjFRC6y5b z$sbf9d~kD>97gG%Xsr3cD5=#zY$7RS33^Zr{1S|QDUo-SrIBF)c7bSoNq0(IYxnv$ z3avyOh^1$QHSeB&CoDQ;btJXQoDFMq!-w`q2I)%0uco2By1efkrB-O^Wr!8JD|)A--3qziAOo=P%o+#^!Vv7o;|05Q-mfVj!Gd zfn88tN|u0C_O&_Cy^ag9S=`dz=OUB69*QB^Jw{X!H5xq1H`U}j_#LrRz8!v#1S8tJ zhznlrXj6P2RP5Bm4S*$hl0xsJ@D#%1%-&txU=C=S(!b&rNcMLAq08NuJnVjpv3cYJ z{K+YgKlU7G1|#sqw-u8!m{Mb%#BdOjk8AI$T&vC7o3rhtEo-zK?rKA)1noN+X6H-w zI4Wzq(cB%+uvNR)3ST6JB^;U~G7#}cceBrqghjm;)y0*J&A0i!-yXVLMU+Kbf3GkZ zza4#Y18-=B*@b5apLX_-r>e3ccbzx8544=|*bZpD*(I^Or%k=_1Y7f+HR<+OLWm5v zMvJdCQ^}+bDgPzLMw-j!{NEhtJs^Dg^%zdCtM zd#R*X7V8Oc=Z1^TF8H19kymFWj~1gpI5%lz0Ee9)58H493~?#4H{a@vxj#8acTX?Y zwBa{L0>EsZ{+xNs^#^9~{XQK)kD<>T9YkAd@wp(^Dv{Nf&^{bOROO($(_H9t*^&ui zdd`l++gWdQ%*rjfJ1mHOt~t$zWOj7ER9{TrEVe6YvUj*Ea?0iHx5Mr`?_-g~@ZCi* zb+Z<&HZhy^$nA|`b+L*kGsFWF+a2^5m1haH`-j6L#XI5`Oe`fDO6&q=Kzp(koXLr)X3`#VTKps> zOu{`0=+eN{9HlKbR7Zs_lW(>XSS+S1x*~m-_Mmg5!zhi(7JNhtg}#)njoJ%sZe?pZ zP=5R?vk9wEPP3Hzqe@H_(b!U#CiRDbkre+z9M`Y>H+x?6&f$C%Cmz$isEr5-4o&va zfg+W?v<|Ygvz?}vW}sGQhTFFzTn6`-kLZ}(4!6t8oWAK!(X@^WZmd3A6xS1owUm#3 zjkbiOYhPYXhf?L#FAwF`X`Hb-W>xlg=envfIuja!&(uJ@1rBRGjGWp+UcGyW#!L!+h+l7*m6zR{AC>ATpHnKoVwe$xMc)3lP?oS*o zKZtmkZA}}Oirks;uQ zvf$97Hw_1u&CGXbn=>)It~IXQ9fMcq?0dOk^=@eenMvD(aoL*8;l$;@sTRw25&=*O z$a;C^n#A#CzhoelteMReiH(oTC_);Hmg}tN2uNQHdJUaprgMitGQL-XPp>s5)xq2% zk#iwayQZyAU(Z$zcE*mKG&$!ba~X6UVDeaxmC#4_RIwTfs|A!cRuFaGE39*Sg}`r~ zbjce~Z$-m`M@8xJr%YzDuY+D@+THBd2NCtFIaPAxu2|-t8tw27aUFlv*-AV&s606*U`WpvYB9-7JaYzi zwoay5jGesoXd|?2?PgcKJsy|1Mnx{g51#Q$p1oZhoRUCJbqgYR03mW^2?kbY=bpBC z4)#BcK2d*pBK*d5r<4OZw97kpSCMkdLi0yc>KeDh%Sh1F=cj$AAs@Y%{pS(KA zd{0(FXp)X)!|<9gZU?br%3TbW@xd;89F}-zql~}TBb~g(oR{a7xW9~e7x_$lPC+dz zKU8@KbW7yZoUbES#(`=suUmw~x3@tTll6Td_Wg+CJiS=y<{?`vxA$OJ%{~t5KWiN= zSf)X!2v!Sw(G*+F=ysoaE-F4yQ;FQeeG_!Xot*WZ=$9FYTh(_lrxGZqKd1k}E|FKR zQLfN-yA&m`FT5eAqL`)UHR^&bS5o6pak>&D7Lt`zwG{6E=F^fdG;(FvHY1ifaMP5# zoPlWJ_3pD-{JfMg{8mm9)W0FU$8{0(ctn$NKMD;68_%K<_2Y*{vx%cGJN{s^5jA4y z`k#wavHE+dl4KJk6W>hN*I$OLTZmOMp2&rI&{iVo@s!{>RmkPLKVsx;rJ97SSo~z= zr8;_ts9Ch2XF;A4n6A{fO|A-BOn#zkm}At;26TE*?WIg-nk-@xsCK~cwZ8Da3M`HF zXEIgvoZ%_5vUj2CE0b@ky^F3T1N>M}RfO_yT}?$y@8#n|>9d7wZB~;;Hr2B?#u{N< zVF;mUyU8`*TARV`x?X6|{P+h4@C>y1Tf-$mt_CzZvA7;N4y7lNR|>hs+}7DWTqQO+ zO?N;uM58w|M2lrt^fRQKJC3mlaS9T2;BquC>K9m&A0cGO3_`OE%4(qZXph zAB8@3s(B;I9QGdFOu0IgAW!nyzX!#MCvKucVtm68vsSM$TFOO)cddO0p-#clr6bny z1a_biCw=D1)R|lYVg>OU_LE zNF7A|ka*&}c}rxfExZPAck{UG>Wudf3wu2?=gkWHr$Jy$@T2_G;{W7-BPac*eHSD7 z`Qx7!5FrxxU!!2+e~n;i;lBTCgQ|=k@UIQ|UuuZ(e~f8l}2;t~62@Nx}v zz`y)8QCy#*(kv{|-wRluhEUh9+p7+GBci)wA|D?hh>w)jg#WSK2hMPOr_$7iZg~q$ zY^pWZ=<-sE-RB5ZH$!VFSJd1dwC|=%#G`vIeZCXcxppX zZM#hB;))4yqufbvj~4cYsiH&-?_`UviJ$;a4Fu?ewe+R#>NJK5=k!EGei9UNqNq`z zILJNvi^(!RJ$MV>uYXaN&L5WuXSPJ;`P2*QA|pcMmf?GCahI6t1+DRV<2kaZQoB}K z2I-|pDQDKH`+-QQ0Un4sOh-!0UeNv>zG0D6g&IDj)fQ6f6iXxoCp}!2ydFZ8eN8;b zLk@dos_8Y6O5v?FsP}n1^QnPu^D_KKoZD+jk$ZsJu~ZWB7QuKmF3S3K61uGY#)wac z85R;HISvBU8j{tb;WPV=Z||)%GQ?!c}1A!fU+fez~x7-_(k9Dx4wOBD^6YlDx0i?he+W0ZSdBsIjK- zkhke>yJJPI65MOHgECN^BnRaPT^*$Dwze_1x$V7~z-{7ah578El9pjYW9$vQ+;bU6 zuSfUv(&B}V2dM3N0ZGvL+K)v*fgvwzFp4aDWU(K{42da9TTMHv_qdGx%f7Bb#T!O8pJ0RG>=(>)ZgJHgNn3{@}u)0f@U@; zL*e;@v*Th|^ZLYH#X11}9MV0tH^)vTx7Ev5}#f_Y`0@#)qV}v(z~%{)W8F?*7LW>tWX!KDXZ+cT<4VY`3CTP zbnNisADSrIzvF1%;eA`EbWb9S3l{327T{r1`;}(&1&c%=15K9!qNWy)5_N$;-~1`s zidwyk$wot+WuQQ0FgA~LX6lZ(*a}f(k~XqU4nxFB0#g8Jtavqdn6FU9dh~6f!28;{ z=G%HIC7SMHKraEh%(9QS55SfJvi$XT@CIx6-w+hBE-oq3RzFcv-X*GvDC8l%cJCh? z`ME%`UaJmC_ZkvLu5Y^G(@v3ViOG`0O+TJ;M54g;nbTX+b{#8LWy6Ua=rDY{vV(FQ zK4i5133vNMF1WD}Jm*mzVN6?{8Mq`!I0eAsB_*Yi4Aux(KE7!-Z&qLzS7--iLSdWW zcC@aF{Z8Eb262_UEmWk?OWd`9-XDNY>p|)|?DnkyDa^P6ai@3e3epDch^Owl(3>~qvHG}3U+LbR{Rk#kqg4|x$c5uQM`E~RU z{;U_66Jh)>Fl}LWT<@|2E>l}SE(5ocn<)ol6Op&Ssn>!JCGjz*sYsb_$bCin9bN9) zf;u-Y0(-F$KP{>j7C}|0!2RxVb}hI5!$9{-6iJP#o|GfAAoz<^nR4aogDgHFAQ-wRTE6{+SMTK3LhSXJ-F=y~?oZz-p>+ z`sbIhR5Y>IDF!W zUP9#c{&sE?>PLIByP&H9mn_NUHM)oq&&Yq5$f^Z?0R8T+(Zkdcpui}s?#o`!9t(uG z#y)O$1PSB4ux5>+VK|h%<4Pt0v3{~`OCsrfho4A3%`JiV`Q`Qd#G0R$x`KhQ;CA0W zk#@#4dRLB#kpzJ$R}KC7~P=?h;6oE!jbzUP?91<#>{FX@ANo_#cEO z9?&06dy!wi7 zor>e%d?`jZl?cuX8~+nkElRHQvPii2%s!SDxp{a73@9^>so~YMMP?8YWjHlfpl$6A zje!(vUtIBFud5W9+!ULQ9FiFbIhX4ayF2kZP`aDw_m16?U!*y!RtK7FT;Z;&Cm64@ zV!K;A#JXBXx2rsY=)LQ`1lz_?6ame8jkZI%N;e~4C;{8u$0H6kmPtb<;M@?Zm-Hww zKJHrtJ(pm)wJ(QTG~*1O<6X1>bBJLb|Enq$d$E@8>+P*NU<4!R2!+%R%%1@AR|~2E z79|?UUVhZu1!D$L`!`9Aq1H@Nd*Zt4KWD8cv+O~V;i(8orDe=7_RAc5$f}P$aFwzf znzrjMi59q4fqpn>RJKe=(nxDmvij*n=gr0BOLT9JRKachc}Eyqe~8@}JoKywVX?CY z0K;z_FUMz}@@9&;HQey_S8vSGuM>jAzuC-qJ^awW=r5E@xG(Ibb(svIY&K{r$lX+s zJxpLgz=6F&P{x`~nb;-Fyd$!9P4RY)E>(%TPvkT2zOp2?w-82jg3K{n3L1Cy0ExoN z9_#U6ID;^NqyG3`Pkf1m^>@+vrL*!;D24(7W_oa}5aK=(;w4-w3wG!^CKR?lI}H8k zm<(nVKQJa(`B(loeDe@g9WTycvYhncxc7-9l$m^%#mn48$p*Wo&K5@nn=}}A|Nc?j z#TvO%z0n^HulU!b@+cM-{#xCEe9K;-(vY5BstLb{XO3u?7#O4A-iQ%PjpKK%GlVeN zoV&tN;Lc7`k6D}RLQGE{RHG{ko6ZfX*NMD!Ww*>T3kk+W5}sURTJq5`^Jf_l-dVud zNiqg|uKwM%Yhgb~OKj;24sj#xj9ZQx|7SF%KbNx!OV9Xzf6M>1>#e_PWUp5Am7AwC z|7c2{qS)$HFU48C>gLC0_KzJOw$JUA7?|UB9ki0xyW2`NPyBojHQ<6wQg4EIE?I7$ z)!|O~3}dGe+I|16*UmiP*`+BMhhnrj|(=ugNWWciZXMQwJTluKY@$LM+GFkXhHy^VT)k=VEzYu+Er&Z8=U8GaR?gFpR>SXUqK-q%6 zzlVm~p+Am}@?CS-#86B*SL5J!p37H<;H`H{u$&$OFF^o5mO{k&Q|5G)xV47E&G9mOIv! zQ~V3Sq{zOPXg(X(LB$j?kNrLvtojDI!o&T9v>YF_u@L%r30u;d@-Gbgz=iw%0Y09> z;Vzgh-IImzRl_$ds#m3icc()sOeSW|&F-I*c3771|H3x8Js|AAFb##r^?yJ7{~XKx zF*3e?@84iZJb8LX{R%B4dU(udF;jsN=r_h=%s}Ln1C*MDL}q1N8oDjvi(7s0S>&c_ zcJw!C_wbfBg8=UW6c^ zYvT_eG3&|D7+aJP!JXwl!7odV-F6lTdDAl+SS+%Mg||?=W`8xW9dpo4C3NQJ z$}|6fvDQC{;74j7v!SKZk%?V2L-WYE6rQZYpr4wKi}}QK7Vd?PWh=_^mf{E9tfrGw zYaf3BzDS_^dGdpVA7$rhW9@Gs69gW3Q$X)LG0#a9IDu_n&I!;#9*D#)FIjLgz;)A` zCQI=(ICTPT)6l*v(mXLmL^JbJ`(YVtd~NT`r;zAUs_Ul+Ip7G|R$5lj94^-8pvL@> zOnakruRJy@dk?5k4>0;E4Wyx9a-M8zUU0ph$V4kJ2B673r?M6)mrsQWf0NiM83c3}|<= z*~LJKAtc4&<(JGv*Rxcak9V5SpYUH~(3+`z*l53#fP&V2GWSuOU-I&8j;?Qvy`HOY zYN?fW(iD0W(A!*2c+a&POcl&JQ%X2~zxn#=r!m!+bT{qZ{vO=EE)eYtls{<7<^ni_a*&x~~HANXL>T zoDAkO@2s{&oXKxPyTNBq7s-6bYjE)Xg<(>y{{cFUWdmQj64LBFMP=L z?FqRPF@df9W9?XNiL*}@#TZvhz=pm%0|zbL zXCGEO#8a^&_>8&sw}bV&8GctgoT>7ryL=ENgZWA+6LPG!hkoYU!25nCh#$+9XtX`R z#oO8C#^1uH^WydTJy3hDgJD8RYqoZYSeIs|Nti~k`V;-gv5Cj%?8ty*j>zY(Pb`Y3 zv5jQ9tv{Z{6J2MdO?@|IK-Q_4hmAz8ctfAxbf&-hUC1gvq>g{hWf^pzs4rQ~+-FS9 zcy~i!Gs3K7!&8&x%H3EPV7GEfeR60rigJ)y+@~5B8^KERWqLKnv|BM~q<4uwmf z`>~Dc{MzRVDIeI?5Ip;%9*yEPS{<53rZ!C8-QP(Q9e2L5xu~VAoL#4u<@hnu%|X0M zPn-!PPC)8BXPWtL=-+$=OXL7SI%z1Doh*V(LE~w%FGOwZEzutK+LI`&_{?WQ9gBrU zy0$s54tW|~F6ArD#!((8rzyn;vU-`7{$v%0ItGHxtwk-{8CVljAl1wUy5e-E%Z}+n zXKZWVjRS17VdjF*q)Kuf_GNDYujrLJ7k~!OfsT_?oATUIHpZY`ltbNM8uV&$##rua zwMLC?`AVxnc>2}*MX|J{JZP2FuJq-(rcx8+f08*n$$uTX^yw3m@^0z#rUc^yO&!LR zHWOSiH0&o`g4V5+ZtU_hci2X+rUz|4GM1rQ<1b2T8M0bjnJR!TE_uC~+4>f%`jr!G zBX6q-GjPrHq{vH_+_&1rLOU%hQ*Ym9Xb?3RJnSr3%eLhONcIh#T zAMn~?C1a_GrDvo>P0J7l9C6_j_Xj;l}tm( zBPq%|!NCBo7ifq>#{>7pnrUrRoJV5r)@ZV=-B3=QEZb#;YP z(_Tn{3#QX(CHW%9E9CP`$9HyjRO;30c$tpD4e&L)^sd1&qbHhF1Hjev8HK^R1!9OR zYvZ%*yl@tY+PYg^wwCb8PL_#RQervTG_7)5rPK~Wn*x6be%OL1dkT#931t4NG^Cic za3PD;)yl2h^6Lqr2VZX1Mryk-w(V#jlRaH3Htf#>`B{q;7>3z{lf?HA456MN)x3tH zj04t~kMnfd%QgIO%sBtd5d^lJk30K5+wywg=a^_<`w1`-EazCpa|Wpr+jL`)Lt);W z^*d)N-opMKYb2=&E!(&(P}3AWRihJiSH_<)V65p4i-{!T3{YGEO_>ZBfj8PvS2&Px zIakOP+Mq2J5=@LftvHE8+gj^29M^)hX2=1wnDw1 zCJVH4+%e5mt9p4Do*gvuBM|{db$wuFLz;_TyXNb)WJe1XG6$!K&HCM+0eVyE_OETK zV3zD*dFN{2VP^lOrJe7$&Y&9_|cwdXw za@SG%e}o$Bk@8dKG#~$}s0c?O>d5w75*$ag!E;ote6H_&_l3H%4oa@I`RMeT|Bt7~ ziA+0$Z@(sq2Ng~kOqxQsOQ$tVPczq|7^p%VQ7jhNzgwp~b+538df@D^OIrL;4@W&8 zJ(~S1Z0xuwS*2G+4_+uTy^l1HJeKvlbCoal&OA znD(e{?FRooS8Fg|<^AnUY{5o2+Nh;-!?@0Iz_kK^ zs~}YN!yK+uHqc3AM6W5MQi8|SQKhPH#Q}N|U}*KLAj@EEkO3m5NM4)6{1?~r@X{N; zv;eYJimXWVDKukDQ*U^Lef+PEXMd~Cil6xf-CF9yC`c}_kpY!^Tf3cBUJeeaG4*y^ zIh)l?-DaO7;a}H8(n?{V;@hV`UF41Xd*Nu){FXj+yhe==LowQsnV!qv`&&@pc(qpG zV$EeQd;~JB_bVKjS_ArQ+2z3ymF-?SvILvU3KBnM%IVQ!iDgB3(o1e`z&gI8V}!3G z2ri~wzO~H3bpqTA&y_qL<(K-eFp{JYhJYy8CoLPxn=i zGDn3oHO)zZXSRC76VcMH{%md3WM9~D>K$nS&V zBWY(`H7Y-)z9i`4sL5=uc2|==y?(v+shJ@G3GRPoc@f@MnlRVQJ@yMj-k$wq8H$u-cFD+A74Q4}Y}oOgM_!ubFooC|1Vm zV$0dZ>@~a`S+1*vfzRj@xqQYX5hsxt=TKy~K)Ht>I9&_v*OjZ#j|2xyNw#;MVZo~y zv6C~TOnWu&?T5ynkUa-xfAjNy8b?it6=?clFS6rHTG7H-fXNJ|=VB%mAs2aD4|RPs zf;K&)Xfz@dU%q^a)c7N|bmxjA^J=?uByj8#R%ZZ_#>}eh7tu24?q8tFW&&aCbX{1s zTtl8(UOKp=-c-;F*!NuI!KWcrzBhFp=`28RH1-iT+(T&(+OMJ)ZR{TMe4b@gD>HEDG zDw|Q5wjv&1yzVdb_iKgi*3+6X>oF=`s;{+A@1(z+Nfz>(YU2zqIm>^4fgf%a4^Bys7!JcB_q-MsB|W`Tcnht& z7h${SoNy=0SJ@JEnc$F!pf9SmGVN+a4z8EJBCgb3D~k82W?of>c|OA=8Rn;QZ7xWDDcv|XyWnvb-tm7 zEWByZw(iTm>f~{5uRk`Yc6M=O=XGH*A#Zf_HTs34B2jA&%VsVu*|HT&EEj?O2;(XXS>vi< zeB;`CR5szMlj8l1kD@Uusq`Oh7jz9~e%T-llJ@(ZItf?3pq?BM6`Ut}HPqw1#Y~`5 zS(siOCr7k&nzVq?cdx<#vf6zHb-#6&_;&WFxPD!3sN5d=l{!uF2WwJA)ppS4iV)w2 zLqXcF)sk_6MwAU&~#7o*WTSyU3;$u1u?s zC1q?8>s-uL8l%>Gaw@th&W*Jve;@B0m@iZPTloFwbulZ8k6cY`YQ?gHMx_;j!SEad zVAE;-D(u{MMOw8PM>e51M&MbtQ9B;g7Wdw!U1y2!P zV%`#$?SlL(Vl5UN`h?(=(LbZ+87W30ne04ydS#t0cUcw&V68eKaDhUoFYW#8(xLd3 zgyFZjpRTdlHFX4$Y`Y(VyY26A=DFoaI%Dl5hiM6~7*x%N?mwSYfs<}|qni#s`&5&S za-OPM0kRFO|CXvO8l|zWIRAW65h^5y4Bzxysr^drs=YR; zeGC_*$>YIdO;>MSZSgm)^T!@oykb%7`c(I=R;M_yhEs8|!5ld|U3uf>sk-=%?X33q z^+HD|nabBNWs?_!5_bK`5>ZSKjzdLiJfEvpr_6ds;Sc(0=U3y>52n@*?8m7C)4%}z zB$5xj*XUMNAd~&Q2mh-vLRK_8g>-aa54&dmkF;Z_zgJ3bstzCmamG_0=V&h)*Y4zVOXvF}Jnx9Iwf4cPRtTcj( zjYhQS{e{#1erR9paOMGti)Ff&X_^i*r#VcPn9NppT=s}QuQR0RG`Wy~o2x7#2RO0o zxXS&XcwKU*x?WjYCtkK}Aps_gh5Hqz$F~mldVEQs*LoO@Z4qExGm67NQpXpl}M8?Nk|=X0*7b>Ve;B^$%A-9Su#?#}BNzt%;g;%}IoQumS9UCc-yWuP#AX zI<2m-=4%02%|q7e^`AQnW2wkkYfdzf4BfcT*aV7=4d|(<)xTw7-tqs7rP=NPi1ah$ z>xYu)@@gZUaz=FXY*}L*WEDEiPpx9^wXn|Txhc+vhNVB;Ppe#>>M$=j0eLxAhcvAT z$f`8IfwSWa^UUuJ;qPy@2=75J#jSs+LWY_#w^J8QJD%pr{5wSnsaafAE(b;K^Z>*W z{c4al=SU)Tj`kly32{3~$E8!ZN!8v>cBq{g?0Oi zr2XLAaO%Z@<$iH~c+~r@yIUMMr6#iSoY)pNzuA^QkPg*w|E^X$+eH*`pou001Y8IHRyeaZD%!a5dbkgMeK&f$6)hO*mSs3rpI|U9$R1SR z^0>>70=RPM^8QHyI>o>?s(LFuBhp90-$V~A_{so7opL7P+YWz>WkglPnQkzhaY)hC zqwJRD{4`wcI+U-_82R~BBI^dG+mdg)myfOsy@Kbg5wE!6Nkg6Aw=`}y&dYH#y!M6Y zc8QIr-Hiw&+dbyzv^I#<{vxAkt5iB{wB6J|RG}V-m$B))J}TES|X)g?Cp-y(wA`Be5KzbO1pY? z#j=fxqV)h|et+#=;OWrMxV%VN@wD_>ZdRfb6pWkC^__v{rQZj-&;!?5U*%P7NNz8H z+k=onFjEf0dSge$htiiGM4KDs zOBTQ^C^-jwKQ;_`;-kPZ=GpbBQQaK7prz~cQvn0AgaNebz6Un_*)~m$KeBllZP2Lt z_=GA2s+%DkdvV>*U;nMDS5AnAVes~T3B=>mT62);ytJs`pN{*=#L(1=(=R-#~%0FhaKfCb-8|1lJu!IBzI`eXj%i<7;Du z&NlKH0=eVg*nuLIcbTnDqnFTZ3O)xy;gi3(MqP7%d*l@lPhFc3K9w&7BVz zg+oev-FN(j)AgAip$<)>5#I)r92|jOuDsEta z^kQ!XKpjD#k|_k8yG>2nQiIV5yIj2a@E5dwZpTX%(souh$Bv};7kt3msOPTxo*kYu zQ}6`_1w~VQ@C%srret&C!wX7!^XI~=#1Htdwn8hg?;k2Yys+}$+Q`K;%o{91KX(}) zGG#$*ZqHvFY-#DqMYeYA@52I_-WKcH0Kaett8XQ8nRdtUADH{S&XMn*ZQqgrj_*wB z(l7eaLl3}>ytcM%hu%wUBGCNQowP;697DJJ=h5KnqnWIR9eh2{gVCUfb!&ykTHq4? zo90Qv+g-;Cfq@I&I<{JANwAA$=_zr_+t}50Jfh|MDblXX>q!)vPv-V+_PC?s{s7a_ z$B~x1S=PnqiM`>sUeD$F+FqW%vDGKwCc3L;_4rcK`}_2(O|nq$&HDVzE`Jgq*qGnk ze>4QCNJ*TvZGo1#B-nQFRo@y;+~@-Iw1zF~GVWI@MIHz7`DA%E>sUAng6-gEyI;j2 z-X6q0TC5mC#wvOQgeG|FH7we;zbdBrIYmK)+FdfC^2y%IpQ^ttkg_tMn zD+g%(PN-f)t}+mnZ#Ub0f2(A-7PeiA+t zbmBeSj~9Da=q!uflY_k2Lw61PvKQX%jK_6z`P&1MeYNg29vg6loQFGSm(HK7?UnLJ z`Kv)YB&;VR(Q}Hna(80dGo7CirM`LYl!&nq@mn!1RV}->-lzzDg7HboY!yoW^Y?i6 z@zwgn9BWtw@mqFpl*vLVYb5z;Mjqlu1GWwrZeW8QqrI`5>S=2UlIHHcX!<2Db~U78 znqaO`A}gE~CTFtD%dj~-ZK3p-``wFvh86#WrZKdBL_mQI9_*#|a#&3?Q_IS?QN$rQ zllJptIogX{$A~O}JsgSH_G6b*jW^gSHj6WIhY!%n)?1=JZr5V9jUSlPj`ycwuTA*T zIUFNzH2>;hOC-{MG`IShf-tr5yg7d3PawtRFawS5yazVM<$G>xOW3fYX=tY0A-Pkq z8^P(PShLh}A*%04eev(N|A}D7LLg2$F+Vl`UD19sd(X!B(kRfL0~2TN&<#F!98CID z*}F1lJDc{63Wjf2edhOZ-WVxVNXrpLf=Mb7Fi84-huC?6hK}i%O%e6Af#b_Jv}SUT zN$fv{_xLpGj~{I(1n5=s`$Oo;m(uEUi?_QimIjP79?#`E++9-ptI7XHKSdB4lbFNZ zcZf-ir!fqLbFOYS zcYyHd2#ndcFTz7s%8v$n#lkuIWz4)|OG=9Qz^Op~kCi^$SvmRg^;HYW?8_ZhvAoSsA&jl^UD+eP=Gh{~K`^YKW))4=1RCUh0B^_G>zq25W^3Qd3c& z_HMgys{O2HAu&DWt+a@Vw4)~`Ca0`MS`nWYW7^c+(7P1$1~ zx4T4rl(6A1^hZ-_FyignKr_fpqrIxlq^83kg2vJKBK2*>ma~%9=fE?L9moo>ie{x? ziTjinsaqh+5TfVaer(EKp@DQa25Pw*M72o$vj=F#fbp3ienR#mgTeZ6td-<4g4i6vhjNXmdu240@#Zl29se>=SJ2;%}kGG2M|QcUuXvaKKgL-JRkj^SOCGD z%x+(t?2Hy7R?p2pe?udj>|~`zcPp`(=RINHb7J^j&84SbNj$zC*L8ZHGq>+uCd}Sr z0*9_7vN4J*hO$96``1)jCN9(6fw(ZFyp znC({2y=dY(zZ%Q*%iVpZ4fp+tKk01f11Y#;Ak^UivV5!)g<+s!tJ}_ezyD#G=`n}2 zkHv`HI})xR)oJ^rIz!zlx&YRG_{G#e&f(~{5yB!nyCglP;LBYLArozfeuDHS`iqV> znbTFRx6a{I8$S#{Up7X?w`@i(8evCrM;C3E1hjY@@;`u11l=+;p1J)_pwrAVeM{Wm zUEJ;hn5KT6G6s-AvwGW|;WX~>|IT&W3UTuZn#j3%<}$Zb$Zwgg>JWKW=_;1Mp4Yj~ zP}qw$xD3J$@AySmE4!+_)o0kU|ET*Q!|y0Lp2lXI`86(a#ou4+or@aZE8Fb-UjKs6 zL-wFf>T$|^BS*8?g-~oBGI{I@QXKak#Ms6?t=(N<$<>s;;?xqhsn z5OB6R@#sybVce1_yvIxByZx2E3S~p6kYvH5Ixu7BLtm@*s!B5|*46g>VTZ4>wOE-! z>SYq9Aeg^i6pZXCsAoKz(#B5Nr8J$M^|*Jr37=5kAAaQ1^%;f&Hec8I9YS=qaipeI!#LJ>9bhn!u?xb1#8LJ*jXv*&yKM4qZxxS$c! zUXH@d7O}84GN-L#FN&=Yt_Y41_JuS#@xX+LYDd-WBbR&b`L|T!``b3qPa{1nN5GAA zxPeaDf!1VdyR-B<{Z|yP#a4IXE53c4zYrDjPUt(c@Hl15 zhwUcvdXTz_MA*r(V-{C#ClUFJQ6R-|5w7&(b&l0==-;6#EM*zG{Fbkl{+P4psT(~2flAiT1@Lt@r6=Ns+lpfzp=U%qi7QH4po6S zY>=}|`G*PJ*vCh4rAbD`BZ7phTQ^aGS)}%vL6Mgsc!M;9wA|UQ{VUb(ji*ulDCLgW z-u}G(%RkUJKG{F9KpDr03O@+`XPw$GN>UjhNGdaKDdP!sllXYW~g zb@drZ!14Hh_CSXA_y0vU`rpbUa>+kJL*TV0^x^kcfe<7AVbIvyejnDN;!!N~sx9Dc z{1h~C=0>@rWF~f|Y(aPYRa+rG^y(Pv#MhH-2#xN!Oh3}jhd5x$a)P1$%)3Jj{i!eS zM|(BWGCEXtUdj9}ZuSCMLCnU~*q><^Qe|YOFMJ;!Fp`(Fgj{{5KzTH27gbg2Hbz}a z^536EePf){YB2_VCp&y}Ta1exP&p@jfn06vJVKYyqDN2(zEX{3p3}7F8+`Y$bsAgs z+>2rpsYzKO>85lt=QWcvQjn2iny($leOR89L4ZjodEyZgeC+OzxcjR*@~ql>=oS6| zn2blXxP2mXx_SR2fZ@X(s#vYh$(eZeRQ99Vs~&t>96{yP+3+r{lQz?4O(9yuHuX-L z9n-AvYyNLdrVnt&2_|>?heSbPj{{g|QaZFIm!sWK!#ZoEnkD^s5qp>55DF;kK+ zQD>xqVfzkJRqe@_3j{BgLkU*6`(UY<24*{yfY}oH{ zyG=B3vk4Uxy-|lRGxinR3!4O`LxIuC&F7YHQ;BWf^l! zKGNp~P2ZVd4>}){>7LF0oizyZX-agPl^4k-WqeCL+_m8v&Hr*90b9Iip=?^?@z?Rr zFW`;5SmME|5>*vlMSl1pW7CRD^6mBPq|FZ&7Efw1lpos*^8PYhnE}x2nB$MU0=Ob3 zGR9m}`({E38`>(Q#>f`tw_^Hg5v(U0tU3~q z^J4GxQ>sMknk}<8YK8KE=4Y9l`ZLygs`Gw%&+fJl+g0+{$lBOlZtn#tSclrFC~%pv z*P7WlS6Rpx_cw{e?&6)=$;-_jPZoz=Q6_R^fe|qmRd*5wK7Ca-ib@~_F- zyGsVA-tKyADQf4xWuIlb_hk5@#9Ag&UIK*-!2A;o$G527^}S-*Jg8^3XX2v2{ z5_@{Q37uz^{VuF0T9r}lMJrt@J%4azO?DPe0^QKVv8B#PB&3>?pEO|3jwzBJ4EYvO zWx8B2I6b@)XPpr8Dv`=v^vA^X(n9!46UE&KRcuIqwX8Ur0vwZ&IBI6MC2 zZY#X+<3j3thi)!QFz;pL%!Ua~Zhd231;0m_%i#mOmy>iLp-@gCjiJPc`?>-XJhGVb z3PS5)Pqgkw#C0Tb%Wxi6b`s|ZGX@zm*Gm^PWwn5<{#y`TlbO{0?7-HD{0Rd3$BZ2R ziRlso;Z}T+JKiPpy67Wv+z?sV;N9|zip3zWRXW-g_0yJ8`ixZW(T;sAf5AbGcxr=; z)%J^5F2u7~wt+4eR2vfe*n+s5(#eS!id%N|nCNL5*5xkB|TW^zo&THo(Z>0W{rPK)$g#x-g> z(5(2#{{%0nzRica_|;u&%G(JrF%WOt@{_7@31*(v@<}+ zlf2#EpT8c2d3ijmOCRQ&<@rB1_s$MSXskv)0M)a^97{H8-OhKL*;ihUv8q9xB{0dK zbLM&>Tf#ckT~gbf`Y!eoSCk!?Du3D4RU!19R`lPybD~{-;;`ozTOv<`U!}}q4vmJz z;FBWFD(@2yvJ@tu8FH^>l^CK?FLw(z&-t#+5Nu-VpH$hzoa_4ETg^!30U#Q#X=Icz zeiGV|cfdb`JfclVEGdSXH;&17o$orUX`J-<>JGI!%ME_WSvK5gXA*%BROZl8;($qG4|b+sezcjTB_ zS@9lPE*U|n3Q=O`VX^wMUrucnRj%V@i&!M((LYo(yiC~XL@6@9LN=Nv?3z%MiVY3<>9>}AJfu_BR zam{}Uz>&80cl)AC~9igy>r9!)3+;(6zlxoZ6*(v9%%ABrNj(_{p@Jh7+r5oGtDr(;V}7oc9}TFf$H@eN64LlvPsS7 z$IXRE_BiQ=RgcZdmjankJlsoxB4g{%ti>Aubyt6|sRpCS#tKgM z#MSsJjC>4s%f8;F)qRa|K+>bJ7WJJY{RKqHpHQxD-0SKQexPjsiz~DH2&NaMM?SXS zB1X_aBI*uw>#M&k-~3he%)K)mkYPNkODMUZRW#Gj)Ku(-FRGH>2G)N)OYt>F{Wn)&3jhuF|?zY(7Z&KCBP z#aUvn?wW01UsOmLK0Th2jie;FHG3?5!zJMg3b$S}h<1b^gSDpa8}B$LeUmvHY5bpE zPWgo}_iyGh|H@o;Llp{U!b5t)0Iot^d20?Fq>>vuvPIB5iNJDWrB9tJUsc+c zJ8P|Sc$Y=3NinAN22U5G1-IWtQwYF{>Zx2eEqsP})~xHOxUNx#yvW=gcWOPrpWm)3 z{PD*sYbHT8YJ@`O9LX3aG1gA@)GsN-2v5BdX7A1L>#3Dq>y3x5wr1zV)ne+4G39RM z6z^(IjNSE!pk5sP^8Q2Es+)2Nr2aUvg7aj#l3zqHa1-CF7!otRp!_P#4`3hU2FZer z&lI&I!eS`9^!LpKaN!<^=-|$`b5}?%=Cz7u!#csirn!2!5tbu9;n(^E5D_$03b=)Y zF-$Ke+H;OllZPgnVu?A1;PYPXMsa=qw`zQF2+K?wC~;nZgNE%=>@KQJpvz^ZzB#_vUx^@B(|PtjY89Hy5=E=i{g z30zxSo>gy|KBD8f6_V*0F^}&fiS^cCUh_xbtOWWgN6+DMe0upp%Ad5L_`9t#NCK0@ z=ocyDL)D|MT!9$=#4ZoUSL`4OaW}rC-M>8DWOP^H1shh|p0OYzk>HMMEXZPu-SH#$ zxuF~LD=hiX$eu>?&#cB#mZhT=zoi049j2)LBeACtir5BD&>5enUGhN|+cLz5ZyglP z-`S>8zQgWkP&=RSMtQWbL59t%OJapq~|ELFo$I#4CSr8fvZp5V0C8?7XWoym#7K|;aDQbU+xT*$f?4DpvQ@mjfv|~uW|yp& zRqh}rkY>tx=T})~G*@k!CV2A7h?}*|naVbreYY7&rF_}f6)rDhpfKwCl_sq|t*h5t zGiz7ehr4*M1@WT%c3n$L?Awbh;jWsq=LZjljW|5S#>IRli6$Bm7c)O!l=QoT;Gd z)16V`35=!LMmeHaxx^wBJg$HE0Wvad(XyN_7U1x1pL zD`_Z+(pT@6Lxjvhr`y~{s=0tvOwJO!D2}Cndp$h!8~x4p@Mm$IFwQFRp)jtF+3<}? z;jq*gn7r+$t*Rf@N`-X@*kDFesac=sFjcUJ{{zR5nZfN=Xmjt1hftT&QP4LE!csp3;q zvo_HB2DgJ@mnT}0#ztrnbEF{-0fBhvGyL>gRgdk8)OENq-q||I_C2gO!;j5ezH@Bm zfT+&mH4OUip*N4~wgzu4@Un?lx6>D68drlkmz;2^p4an~_qNkNYn=_o!mb%1oMlAu zx12RMK+w&<0u5(-JEt&e>=WCwoOA4vgQn{GduY8CP>r~^uIy@V$ReA&!&_H-eP0p3 zL5X|0|4^*qji0N02=V%=IvfsbW7CghG6$imH$xuf%}z=S^NtfH#YogT<`i8aJ-KW< znVLY!`y~jryrw_zbQ35#l<;WOnS`XWg9-xnlcZaldmRD(TukPSYf-R-=$hss?o3o&%7@$Pi!?dT_{5*#<5r}jDF*j`rchob;< zDCHP^GC(^y?P(#Yj4uh}#^U|o6y0l_3uJhr^gQWa{%}tPqN%};gHcIcXNXzGWyeNR zzxr_y1#NTY*`3z+1Jbp(8rF1?WX`$kW(T$$m^UIU8c~jH$$~4d_+b6!P_682JlkS()A!COjh}KYT zze})uj`wW~8vN!{j(+FGJUMUAovvoF480zRx$wnz1Q#|zctTNVqzG{*M_Nkm&E7LD zUwQ69n#lk9k%k+tPqxvdPvQJp+2yr4l^%T%?YvT{z7w)7_9I2UAMm^Rj&GdSqt_iefedls6?YtnT1a}{ z&GsHL+>7^cnoZ56#x`}*e|Q#uMS3W8Kb=db;9z*vb9+M9pP#xsaltn-Y=dU-@arJd zDCe9w2?jb1D;ZZ_!bjw6R&%TIWsQW=pq^Dx)q5gmVtJWXtw!luZ&ny7jGG5Abp=cX zhD?L7*%)p&O5Yq;FP;ZzfKZnttjwt%akX!HtWOY#EX^}o0^wZ`T&5(w`2K6@&jm6* z8~9Op2OSk%DKSdajHSAU6x7*OL@8{Ht#ixQ0&wWi5c} z*C?XRqmdc(Qf@0Xe|kgg-GWB8ku(ax8ezWEDd~?L{msZXIEEcskwcu|z(?(1 z-}Iea(HyO_0rOu*QQ$N%u`N8>%C?ZimUxlg$uu8#s_aLfZwvbgEVm!Kym#u$N$i~0 zBRg^t`klA%CTEq{IS{m{uAgaaf8+P5blL@xC(Xey#t`6vY3JoyK_O2B-5AArMu+4` zIFPdW=8*KaDW%KUomIYNfq4!udEuh7Mw_FPJv3@@eHc8?A>Qp7p%rB9e9Na&@V=bc zdazx*;GyJUZvCD|88m-ub7SUg>*?4O+S$rix=5cXm;dW^=VsFox-%RKU)wwhe1%cL=5FcD{N4a8iJEZOvsbd&wB``Vz*-hY(G9hT zwC`HRv1jMP-|c1P)jz^*<5k0dMvRPKA~y52BKHUq?fa^Z`+`MC7gE~I8kq1<^F-p$ z8zDLLt(F+I+Qe7^f4}#mPM`%hd`x$sZ?xi|oB|QKZA^qW`f-vhKNdST&9{oCOUY4W zDErQ&_;N&Kd>m5NUagCpD9vTAmKIe(hVDtTznxvjtOXxKC^M;VQX-c8UJK_|yE2r_ z{VZ9w%TCS-g0*H2fflrhr|;7QvOQZrSi=;>#WprMBJ`~CPYUk0OyuW?7TiX+S$;dbkvr3wF)IJ!tJ6000s z&XS^7>emz=?8ana z?^Q7qYmfa}nN7dowr3NY*Koll9A)Gp?zjIOKjg>Xh={q-KtX}C!r!kE3`UV#)}esd z0*Fde51sjql!zj_yO9KRI5=p##K4BL>dMbRhTo!4v0I=YIM)J;a@K+zFg^*hdn$Y0 z&W*C>E)={5r~Y>U&;?h2RnvX4KcmV)GfUh1jq2tE=`OzNd^1;QgW{v=C$sKnI6qKe zWSgBaeJz#sgdTmIlJ$NIez*{wC(6%VYvaXwZXVR zyzCnN^y-*1@ET<1X2B3HV4kr#iII&9#71Z65S-HI?}8fj*RQsTM?yFMwqbhJ^j#0Y z*K=ZH4Pzj`e8@#&-kwSf0Brn0swK;vZvFVH7268{Fy3RzMH1Q0(9z_Cpf&8-HL<~?2!JP*Jf5Fd>3V0se-38riSbuGv0h}S!aKiais$ZT zO^(C@|FpttfbRXpq#(KZh3kaFu}#hss-6psX|W4&U0kqOAxiG*;Sm(c*0D(95sx?rE}~CCKoEQ-D~|E2MVRv@D#gfW>4QBZMnn5aDH*% zl@c1nK7c+V-1_m$wKZ|gDPvhXIZf`FoWKW*x}XgjZR>i;B@6Pm{x67?aahPpISvyi zdUCUt`7O|SDFjGc^0@$p!#tCW3RwB7olPKStsrnoDvW2<8XXlYF9t;GE`^0vXryrN zry&mj2wHW7-=8KVpWBYOdve)rn)EftJJ?A? z^3%F`V1)7nt+9!BVZ*VzEb$N9`L@1R6j;7uM>`%ZxcI&4r>;02qbAr%>n)j8;bOCU z1gTQ8N7^G0{gi5cB(yb`w%il1eb*FMmMY9~n}>F#h`b9I?n=lKICFUpJotX^jm6cL znpRFho#rIL9EV3Lx5;hY_5nH;zD3djSKjxj%22*v^B9{=S)jiJC$BMWu@B$%L72zi z11sstx?L21YWG-`{h8zj%ihT;XSg1NqdaSoA0XXvf?fvbG($@>OyhK2<VZNN``H_T>Vu3 zkaMq3rmyZao|E)?Rcs7Lgb-3n)Ex|3e=w>j`iQUIna53wr}mrucD%Um<>!{#+I?@c zq%_{>7j^8y+8%q(OSN^?OhdvyZ}zlGD1ZhcMVy)B;%?Sd^W3t7YiU#yCG zL;DTeQi-4Jp}WT4*p=t)V7dl3iENA!8tuYuFU zUFL~mt=EQ6RvuO>w|UYXK{-M@bu7^Zq$|@4cnFc4+>9+yQmN9L;S`3%Mz+OC%mQO$ zf8$K$O=)Xuip5Onw=mSU8TCG9kA_W9W}hukf{{X1S0!*VkRcgx_s*ZD55;s#1|znd zy=bH4bC@G(D1$MwZRo-gB%q1t0J0T0fc zHW@#Tq}0)__x)ut&DK9>FVEL~5WlaB;jFv(*tEr6BTNm)QeKC$Fh1XINRNfk4gr6j zFA!o2xxwT~Vd>zi8HC)0=;Dj{a`yHL)-%h(oHetT9z)G z&hR@#RW$!>wqE0+on^%Xq)^*T%@!IqibUU>7b@o~I{cS=?`vR+2u*+F^PMgNL;6od zUJL4AyhfZ(g^M5V?=TyqO4YA7e8PYS38fMddpu$2oWKl)*XnB8vmN_QedegwEt)$_ zJLqH1jc12&Q`8*I2g@KWz{Hw8c)t#Pq}!DCQ#TA8UMXi3KCDPT zIymCO#}}_{UnE2$X4)UObW|og5Dig0@6&nKhkK+)>@1mYdGWR_?cOh=U%B>$A~zdu z_db&>C0_X!G|EX2bMI3}2YR9ff2KQ-OpK4$;)8+S7?&Jq&vIhY-A+(Q?F9SmOp*jo zFJLuc{1S=%fET&qNAOVZR18yau(B55SDIYXxq zI4EnOx8xU-$bLs2+FClX(1{ae+Ra`8zq#K0Lwq8Md+U81qEmPt8B@+T;QN>R%J^QL z^y5x=CX(-flUE?PAMno*L>Dk3Qx!e?mx5WwY8m!_<$VHBs~W1*oNZFvmoSbIMk*yg zf*5R!GQy@lUcNeCboFPtQq+jrFw3gu#Qv%SkYz;|&#gDS8=t>;*|0(b9xl@$?1X6l z?rbM5BgFMR@a-#181oy8c2yF74DV-pd)*k}cU!95ck|ikk!&hkn6{!g-C3YtjM1(- zWt8%2__Av8DB0H>6vc;eIjk&${iw$L2Na1ivWFw|Zcw~AF*wR8U~AA;Hu6r#naL|e zm8Ua#^4Z1;Q*{p@tM+R86}yP>?Im)N=e{fM;7>3C&y0P|c_H2DXuB2 zog`~Z)}{hlRFx3WBB*k%_s<={GZFWK`}9-sQ-U=Bag-~ zD9>eNhA4xcD=^y#V? z0WHD6cE_(;&2Pb~=z8O6nx9c%+;0cXO`ens`tP@5L#FdbG}7@-SmND(y$a3+$ZvNv zk7mG~h6w)f2YiH{_+Ci3v9yUw#`lUpb(EQ-uXIo$uu>8;C;TZGm) z5||LNu%RxDU#zXy7)OCEuySyD>U{}@(l)6-o+l+SyS*!8kaJ`&+A0yGsIiUgT3N?Q*<~3t#h8ang-c zMw=fg!kwnh17GwMs?!~(NX57&Ep*#cc4o`v*{X;BfFwS~TCaSB(^jJTDCT}(JeA^B z=S_;pK_2lVXu<0%0ycF9hWi@radUsQt%ExD{T;NQu2Sm6V0)xLf z4jI(Fce6yy6lSM^Ry<2TMw92JNXhLW#z$|IDj&xs&To|R5=kLSzOCx$f|GSMVua~= zyg5(8#eG?Cm|=;q+u1M{%tGF`b`sie+=kHm-?-c~Q z)0Be3N0of}`{ikGSKq9~jNBLtYp5r)ZR>q{LqnR|mc2rtk6G!@{vo3)*b8g^#HGc^ z6olzg!ZmJs+_o(NkzjZS54fw=yU4BvjPiM@9~kuBzegDhG?nf&};Z}1!OhL63*0jVQl^Y1$cd@q@f0NUuE#Hp`1`n&B2rq`<& zI_aVtXn!adA4H{a)=?xmbt;{zGAFj~g3od&qh4n6%etKyW@fX`ovM3`+mjER7E;QT zq)a)Uweuu*`qmsbR{xkXTtvK2GBAoL{C<(+ikp;u`FZV}dK4*2;B@@QS^#OEExpT` zpCb&d`*m3g3XnZK8iUqoG2Wpmu?=e2fyYk$h1z7FnYhY0%+}WX4GqNw|Nb9c&f7S-pPb`jpuR|WG z`sn3xGssWNwJX|VTC>~lKVG~2)e}18%%;gtih{*lL^i=z8^^hRA(@Mc^SA(0?#xU2 zla|nt@qX?=#$c9GT%y%OINM`HK5ST_YowS&tpAkc58&HQi2O-dCn}MJw7BF0Q&QdU z+@e*`f}%?QX>a>9<1i_bS5pAtnuq|>U&vn zvV^r|t1Itmw9pY7Tn4sP;X}mJ{z#dDpXMwxy}maD#AmC~=I~j_n;y=8Jd=D~`44%y znVxsQ#sWL>rA)fdxu#3K+ND!rT8ncQ0XjCS22wxMgN~3+-UWpRE?b18D6S$Zs?wer z&z|oK$*2(-S_m{qpP6*O3Mn7oN#!9~A^Ba=n~B?mN9^Gcr>zP`F&8vT)dxF=t4+WTsVzEboegoUtn@zuN;_zz27Qh;_#^AtDwDXqwix;;Hwr9Jce;A?BmGQ3?yIWbK+QR18Z}X^pIym{^ZgIzQV=deY>=dSoQFH%9+FVk!+AcF8bRA z#gcH;m7aAtOR`O(MCdyUwje$3kJCABPHuH!|E_%p#8jKbsm$fP@J$vEj5(OGxJAUX zJ4DMW42*_|Gm+RRo-7y_ZW1~=QNF_H{gUA0H)GceZ8a0V<*1_d_Xl=#{{-c(9Nba6 zub410N}%xYihudfTD%B+3#D{f@xJU@pjfKz1~1MiqO7>mf8q+^2dw)oB%6uQcqZv; z%kHIgMtZoMV+;|^1wFU`LsUdZAF}IU-&~Qrjz|fYtZTqaUP<$o0Lwzs3SXMDoit#8 zC)y}OX>UJa=H3@q1U^c{CGmmq|1sN(NG5KrndIG0(VK7de-v}3(NMU58)wiM41>xt zc9XF)$r6)&FC(R7*C6{A#!hz1I-?)5i-v@hNRwSCvS%4P71_p?Z5WUGo#(}K&hzU3 z=6|32<^A$L_kCTT>pEY(LP?{e^s`7kMI#hg?&t&Hh%GV}{6LK%w%WXo>e!W|&xL4E zEyR?6FYqo4Y4m{Kf6Ca#5}r4}$-DX~(D8u!4`}D?I z-VB#4RjVr>9#rKRcs~$(=D7e1U2hc^KwXQ+-k#pBcZ^p_8)Z>8!R|I3a>W2hwnE$V=p_k*P*(uJ=h%;dl$```NM2?+HN2d6LRlL?I<;51%OuAw zWu$vj(LRdwAly1D7c98iXd8mxEm+w7&0?H;i^0VMsgI zrP83dP+6&u2Zhwrv@0jGsC4J;OvSE!f_{ck-Jfd=!gTAx9A z=2fPhRT%R;*Tytu?!t3@N%Q1&rSUso)j18jAo*lOazvTNs43*6?;^UiaTCQI6R;v1 zI!rE#klwMQJu)8#rTBzsAUSTd?eAi+zuBCuFTIdwss=hB*Ecv^=0{4?hf*QRM-xl8 zkULhjVZpHFh45a6Lt>ou=OiG>!?tLyI4U~g1)(H43;E=u1n@a%(@GvRd;LyHu|R-4 zT4ip~z4wmFbUve0%qj6RXDpv6kH+`7`I1v#966uL+uIdAk$({!rj8F%3u7FVpAsln z_&}N}qnw#C`4%HjgpYWU82{jL6Nn)Gc`Y{)q2v^gak9mH%YS&Q;5{ogE0nE>D`?}v zQ)WTGU+UOX%fuTbkw!^fZ&b;mliVRKNr~oE7Ay+$qX0|zDyRt{w|W{aKkp$WACSJo zl@y%!z>a+Ps`2tnHT(7v>kJB>Z1ZS8YHCq>0G=W&yCv)1{71cr+S2QJK}I|PVQuQj zVEIw<1$s-Z0$GUE;eGrkKwt{#$?clxT_E(c}?r zTY_o(2XYfSmW}2@mb_bjsRx6arVbTi?_c3{2RaaS0h)n`reH3eu1Y~lZ}3n~ad)G9 z$!wY6NvC0PP~)bpVorDI33HZAq1zRt@b$?>4r4@qB=^YVz(^7=a9aav7T47bmiu;N zr7IN|{+iz2Dk2Hw7>EbA<^+g3wyamWNNN9a)?5nfqlQp%cV@iVJ8{$=cyc8{ISnyQ zLxR1=I1)m3*^=hhGoNyP<4A2vywT?e&HmCC!UmXM9l1TfQwzkn_!jIK@{Dm9yOqd< z2FCqpC;P8QcFgVl=1t+$zdMRHr{X>uz%nnT-@Th8B3{D_ta!s}P-34nNnj!sj^+RX zjmESZ;9JVwwKU6fVxLq5wb21g4dG&7-_b&r)h9k}>K}3E7IXYEE_vMi>wXG`5a(&B z+rP*%nB8CZ)N~CxfS(uq2V>FsztN(~^2dZQzZ!UVqEiLS4QObwY{X-CA?(jx5-)5n2UD*vkmkvRZ=_RL~A+0 zd*iVVdH5aiv1`L5Q{EmOWL)uU?WU8Air8Cf6O=%P!epPyyrOd0U4gcyl!$shpo=gL z)#cBdA}X5hV(As{OV#34`_&rz`6LO?NS=)Aqy~0REqw~;`J~-jpCD7#S~E1BBT=Jh zh7I;a6wlJP?dM+ij(N8F{LjTS>_2%cVyKEtY6|Rfg4@NA7kL{f@du* z47ZLEjNP`7JqMvvMCyW`aXS={dnJ2J z@&3fbc5Qe^t*>f9XCnVGW9~iWC1dsp59k*JsQkKBy!&%Pxs8*TPghz0#R$3VJ@+sriy zjHhJR0`;ybuJ!WE|S1Qj))*mvP1tN00uL;3XD`pYJlx^F$`%!AR@#z`} zTHO{|2@+=ewbm|c8LbW^_`l~DkiekpcwSMj+lAd4ZpzM9e#JWh$h_#UFDSi;SkoOy zg(jVD-|i;=dYXX@y4d8d{=lP*^nPV3cNjGW-O^;&^UTV)s7=ZPd#(q+@>rMhYiLl0 zdjFJEtyAOUZE3am$n{o!l}98ypzeK_O`vS&@0oxvraDF;X)w8amTxsOY#!ll@jVUK zmmKyJS{pY5r`}9jx~lL9Il1ML>jwtoIes5s=V8ZxpyLv63t0ihH2JE=HaDk7HB9*5 zU2k<&JrMsFDlq>XXNaO&k6{NzoSbjt*qiNl<{4Bq1u4!yqWxZ%n$S3!)<`4mv!W7! zqpxjS;}j)C_8#T#-xe#GXv$S}%gCWvSUBWc8h#)G;IW4bY-|<#Xb+c1Z&Z2TJoEQx zkK%OX#u%}2O=_%>t05uw64~HyS#GMAwkqgg6{VJ=gA=-e)tbBRU0GIj*m11#+Si=K zlUew99=w2%GqcCCG<~V#pRN`Id(~#FDURS7wjx`fE_u5od|Ni8KO*D9BnQsLJ$1za z8SD3kTv>8kbw|G?Z#T7LqL#5j{>Qu8^ctE{NtGcaCp)>GuD<-x4YA0!QpXzd=Hp_t z8}+#)Az1`8(yXfJuulgzGo`*z)I4zf5JwKC+yvlBPD7?Y^g3+3y!(5M+zeiQ*}#QI zZ!)iCX?}EDa!~xu6{(h!Z&77qSf~flLwmCs+do>wePuM=As<>3RdRW1{6x%~v>R(+Kv?nfW*D z=F!-13O^V7Z#4&r&;`_~F6y?+g^3=?fyXf!Bi5Oqb2oH`6OXEd9Fjja{q_ z%uIL{k-r=w)%}uTL9N2Bz{I0b4|2HT zUEj)wfmZygUrc)`xYZ6fppV2HNk--GCsx<1>~)T(K_kTwT z#{2|#tMYfIdi8B_KFPHAwA5RiG9GwLLobm$oCc0Mt0nqj@C^n|NZ;dVn9+sZB89lLKTCc^? zAJ?hM5RZK--58bid3)Jq3X2RZ2` zwiBqDCZ&anr37k9nDtWaauLbhU$taUcfta)a}$p)4?p|X`y`w)p)JyEyvtI69t|1L zO@aBXN&>=&^>>o8HCj*TV3hayyGP1v#EU#%)mO(jNVN#sY9&4|AAFkb-?-uX^XvN3 z)vd0m`75glQK3l3Yirh24&sToIVJ;4vue}9mDO%aiF_!9Ef#@ewI$&VOU>r-+@+toY8}DSyusRpj*)q^UX;*35 GMg0#g}m;2PZBLXgJY-5YmkoV)hg=icZ0 zcOWs+jqyb)D@tRblc2-F!C}dKlTd|&L%8|J7DYw==kAhVd-&&h2NIJ}NB!sc zpqfYg;}g3{YP+d9S-OEuTrJ?N9Gx62m_cT)78Z^mYbUpJ#BL!txKD605~AuJnWt-D zAH@aAKbI4o6N#OYDH37wU%y0lMs`X^>sIP=`B#!?R1#=ZGRUfw|0a=iD3dI=Rj+*4 zX!?~M7btOeEdYZ_2PsqQ$}XQj-40XAjDyZwVcFi}uuSi9Up$2w&X5mcsGmbVgeE*z z06zWKxj+7zOZaaz|3hMc;eXO%5n}QPUjH#rKclmw9fbbdMb~!|pLjpIR9KSy{=d0C zqg;V;J4Q7%wH!;s|B;TDDPH|o163tLMuhd>sKjR)_|E^Coc8YK-(g~Srnr+B|LXj& zDSY`@;^J`niG-7Ayto0SgpHcjO5`OhW;x|$!csv1xcq${+fn4@b>tg|;O5&B@S(=W zfZz8L80IeknoxAVawPB*h&VgVn5i-3yd~i-acB;Vd3n@IpnSR;v|Krm^7o6&p^Htz z61SP$WacimHIA@wZGUu2|4v3_EUVvVcl!(Ap1Qj8#$61+IMAu)ZnT5G%$AC~1=Dm~ zT)o{JuPY{G-&1#2SD=0FLli)P_ay)d+xH%C&|Je-HfdWcyJdTdVhxw_fpRGnQ-)&ns?~rae7K=NALJYpZca@>YaX zC8s4PW1foyx9_;lCIaq$@-n>j;p`T8sgywA3`_U#1k}s6O92IL;q3C6ygws93R$fF z<~jUOBU0L z{s8Br19}RQaMa730vBHhzn=`fz*`k##{aEjxXr zCzQ1c_^{stoW9FC{+m@n!n>kAe*Zh1!snl<*CL}%}J0`$DbNlw}p2yw!Opd z=uC@wdaBaZVTNyofM;@_o|Jv2eyLg!N5QeD+6g5q6<8MZ-+g(vHJ{wK88_WGcHrEfYe~7CJ8MO&-sq+o3yuhVVPdWOl&+=$SGwo1Y zF(LgyQk8u;BGZydn@xtK`9$qW9wyk={SzxyhzXe!SM*d<;^BQOQgBMQ;_?&ugS|iY z1$=Bl$)xoO2eK#PZ#o^Td&j@(`%Xdw8eA4k`C5z&_wqxm{f$g(ZPUaqv$U^s*gbBkNpJA#ok|mvV zYr6NSeq(5!p12?*WHwjZb-SAke_SfImRB&|Ia@N{Eo`zHD)o2cOlmxT$Ol}&P3ikW z!UJjA43?|rc&jIL0X9bn3C`nin|>JAv#jIaXIcO-(;IeSy=?eIa@@(T^Q}(g%gpF> z(*D#V=%<@$Azc%kpK*%f6W59_jI)5phI|;=jSF7V1EYhy-(5q1i{Gw_r!a~9gX(%| zE;X68)ORfInA3+ku)1-;^oVmqsaFbyMM~kaE%>>PxD%v;`}^ooq4+6a^Z==&+Q!lB z&V*BGmLIltf0kII9<#irYs*mfkrYAQ_Tz7L0qGb#wQr*ubz{-E+O7D4Ufm)sYU^3Q zu7A6$Q(5%tHT<%Lk#xu#VKFPbE3ie!al}Bm;FMNHW{_g5r zP%_du%Y09vb%;F4ZV+FA*lxM^@xV=QMA-10Y`f0$Tgs;I@)c}>%H2+s$y zLYn&wG}r(9O07-P0G;8jKsFFZ(P7=`$&gAR4Qd!KcR6}QD8?fHijnQorU5#Cw=`bx1zY;~c$%NEL;`)xHUrT|Y}bP@U@}#7 zUUtiii4{qFrs)2K;b`O0gjTPuiIW+!7M$cx-?YvFDR?WGn8h4YX*%7)7h^=$vzq-` z$)ZpM?@JW1r6tXH^{<|k)b-sN$(}_E3bURc3+azKa6c1Qw)^q@?sp9=b0YIM+SN)A zOhk2`X^Q=CaL)BS*>{pf-2Q3zie=OzxRNUx_qj-CrO4(>OK~!ODfaCk&_H5@<5YEb zq6%~NTDZDLDUSW!l2jh^cEUGGE|ikVQu*6JhzNZAB-e%AojP!BGk=V^PBeJ2^b%3m zC<*2w061Q)Y{!N)`-DfrXX7pOygpNM0mQ2fc1m^NjYy9Ls%IR)J_3+kO z;CeXr@R>mhJ9|9zs*_l#lVp8gi?8JwAVkg=qPJr?-CdypKfSt9Fx%2U9%@b=)sW&u^Qx~6_To-fx_nVj5+-3s=P?fSU?3zTD{n$QQ-Q0XS0X_R+A>X!lQacG}vwp8a~H=BP)lmeYO+bZ%u? zp;$2uQsV)Zx@DBR0zok z0T{0NiPxyJ+CqPKBzYyB0u&e`kA!0NK4ZRgV9?f)myQOz!cgP}#$z*?hZVcsd^xo~ zqF?X2Rm2^8Uzmybh@k(Ac8|V!1sPWV*uD53$9iYBS(lvHNymMew&AEPd<`FuZZ%~jx6o0bgY-u>4fj@)qZF_evGB;`L zlU4cF!o1_T{SmW8YOX-HhVbmHD?|!rzFVmDVC0aB5|b|&AQbSst|?Q{Cj<{`vdV?- zP5>T@bld;#Q@E3DK%`wbw(I)mgm2x?@R3oijm#-te@02XQGgYW;JgNVOp`34#WFJZ zeqTC`cEFg}cYOhuFJR$qVI>W&y4B;E0!cP(er1QC-+H~2r#CK&q;PZDWr)RWplxGa ziTkZB!A=|NN*xg05#BuqER-7BfCiZZ*gUL{7>mnhS?pinU9cQFl?>qvYQVnW7RvlD$R}tNAs0(!88tsf{wIJ4q;bPoh!$5 zF`3%ULE4S{oybjJry-&F6rX23PyHJ%zU_xMcKth`aUijV89c~3l zJ9BoTH2pp8bM0EoK|*qn#z#_)^r!`DtTHRJK`M0(zErC5c?uj7S4n!m!xD>X&!x_` zxc&(`(b7i+kMPVfLzxOJUk8H#$|X9!LZzlk+j(nlMqZgCBmuJ4$;&ZJ&Yj% z+w+l0?4RmQaQ&mfhFK(RopOjY3wN7$Ae$`ECn|m(W7}(yDB<5rGmaeocj)V@e((m) zd{T{3`E~Art#0KJlD$a>6l za()fP8+EUgVX@3uR8llUY`h#?k-_V;8o~UJ221Q2cXH@+GHD@{h~2{KM?o?*qukEj zHTxV_NbZ;SXhJuE>J^)PVHQ-LPnv2+n#@Y-)@V`pDFdZ{AjXQNgKRg6*sh%A#B&W) zeVI3(Dy;A^R~A4Q+T5`W#JqUk2+?&8bT*3cgxyDIm{?tEHOlrb&dQT47KxRjJzk{S z8wx$+3-Q2H4D^(FO}YX3I?RApzWFx06Fs(IwC03Q>Qm#5c{iF{7ByD;nWJOLC z1k36wjAzY&c4FYUiTftllSDR&TsBpt}~vPY$ylb+b?4#lyyL?3}nr+z)S-G zY2Kd}N)Lm7d>*u1(B7A%nILxOa4HMS?ym`SkD_`%m_2Ha+r?lW>c?(Ow1rX~xO9+G z`d=Wx@6-478;D)nNk)9{60_fz{uV$yvaJN_`S5taIY5Fp)_t7G8<)+gTJilI#Y2X0 zr;*Ozldi3cb1QaDR5}r0Mze4h;j7TYaE5JYGPSvdh46x%=qf@7s(?pKQ8)drN0@34 zM=MpCG~$Js>e&73rJ5M7w8H0>13Ur5AR9lLuqkh+ZS~b0?Bw$- z@oI}q%lT@0qR|)PsYd=&hrIH5>R|uYki%gtOx_K}A&qe5u4BTu_(KjBLPB=#LxynH zU)BZ!ne15OlP)_*1Wd0f)u|af$67(|Tm=W@dr>oHbB!cDjYsTN*;KZkg5lEkCdajE z&j~sSgiMbAd`L(Ypb`?+A5LYp^Wrax#w@5LqcaNN_F2{&FyxG%2LOe~!RQ=P$ zogD2#1xW~5EoQEgQ`7W%&bpQm7=(JLFMA@^rgGAf|KzZ3>UF~J*e&I)vemk55HuOI z^r2CCWQ^DDE0fS8?RMwlekLrbdRynA%d6HM#KWj{0@Vr@?QN+A4o37 zH()pXX0iXsn{W<9H=D-UC!3I<$L;B3NiH=-W^G?Jhc-~zFS#Uu@O#hof7x%ijymGY zFa`|IMxO=YBuB)lHbO0v9mdp*`aXVdP&8#PG~XI_(Ji5v7Z@&gQYpe zyhBW6L=nA^I$vLNMMP6(Uc5`ut!ZX*V!VjiGelHoeRx`e48iAg-?~a$f4l%eVVGv2 znu&(K>(q5EALqTOyoJvPLcDEhkmT$}yeS~`<6PGIo&=N*>jQg_W9(12R;H(RY{jd9 zw1Yg|EyFev1v#w(8(OwC{-J?Ls@`zQq>B zKLhdSHDTEnK5i*!9n0Y(;p7A)G&*bnzj{JFTEhj{>Pty_+$v(2WOa8 ze1ovMY3r_M*@gJ=Av}=~#NZ zgnR2}Od24snotcd7GqLTIc)7wX{I6ENJ~-@?ZeN70%w?ezc?S{VTE#H>{O8OTf1OxLU-tFtJ)ANPfX*b^MG_{ zua@dJ&cG5Dr;q*xpP>33QkiHsj*@7j(J9ROAXxp|@OMShp=0~`WIGtJw>T&CuHu(mu%R;BI!DhxrM2s*W{m7WCZZi(lWB_Ge{DGEKNpHISf}P7z1qLDAxA z3!~49jHYu}E+p-j2`a|!a$E1${t_2DuC(Hs|OZR)DD769aqdnVbO zg+x7y7l_}2NgVe&7;ok98?djSt1;+3U$7QZA_TKhu`Y~qfT~y?FOkOD zUMZ-2QP0i+o{xWhsj0^7wkRpy1RuajxMP+HcZbzfRllZIbBbg7+rs8qJGOjbiB(V~ z);#~QbV+MDmH+7=pAd%QE_J2SE`(AkY&jp8-$boeYw(D?`@WFbW<)9wIY@r_sPA@-Q&tni3Mo!U7VIlkAx9a6hlj^_8 zdYKASgTALRk%h-LY0Azn4N{#i&pIk+hi(GD^&Y_pkI!e0PmZ30-NIS<>kr4B7P$cn z`)D3*i53d?9Nk>>n2xxGn)m>u;l)}a>AG>Bu6^Y~PA-~E9#hhO8h;PVIIj#HEayO>xn zD#pkQ{pqoK%}>VuDAmUDkJ?p0@fA;J^KogWxDoP_g@@!XgWEJR^eG;m-aA<^wbg#~ ztYpAAOxh)1c~A(HAW?t~%~zz0LKN+Bw6=nZ$Qo2MPO$JLg-$7#-1jy8<5~+nsGVy&R%A`^R$_apTz>&?RZMn@ zdlJc?n$fB1p%YR?*P6qTA@9#i%TH*9aBJM*9!lkjLCg_%o&;>Ig0nmPCqMTEJ$qck`amS`boAqPl>YAFB zn#xC*EVu{<>37oKrH&WTt>Q(^o+&m{8d?o6@(c_U-GjTA3Z{A+? z|AbA;%Hxxxtf>({td5Z}l1V+It(8xTPp-z>V2i!Nf$>_nJH>>0$eG0Q^aOa@X-&$S zj%I6T=$Nb^3MP!RNC7!zgzy*W3y&A`scHMva_?B((a0ko=9rQ2e0+~Xnh1+oNE?g2 zX7_3KK$5AtJs>{~iV`zUB&2J1XQ-#G9LNLVcZ^o!*1K^WSKUulX?!I(_|FDmlUYVO zVtqW8P`T|MLUds*Y9I(fcfW}eph!p zeq*m#YhS;abXqqQon4qZcd6XEG*!EsHC+{d^->v6KYH1$;44lul!s>dVKd*t#Fcf3 zv1k7GJoSNLPc~%}1aLIsppP+Ae+~70_UMlq$6EEcdGdEl!h-cWfH>GUm`fgQj2QUJ z_2nb1MzEY2h{eREkpvw>4&T?`j>4}m=N3%Q@p79VpHa>tOH!LaEFbNtYxufy9Qe?y za71T0P%ww&)0%?#($6}k*3!hK7qfpUqa&Q*bF2aK?R zNlsHS0q?Z{mVa1mF*C-1Ch?vW{oTRotjrMk-tS8SDGu3?mVO?#19Ip0Ome@#>v_J+ z8xSvzyrby=ctoX(%M&F}hr}@P$fyP%2UON&---UkR`~-fvGj-O-X@V++c~;R3js-z z`R!64;X&~`gThB+Axg@>`9;691#i7s)&~0uoAV;9K3V9+8*8r|?N-gHxs*?3ER)jI zJ)geX+XzHe^9z*Pd(2oaDp$$hC+Hv=S(e4V-}?nCH0rG;=2h}_jb|HsvEgYzd3sW` zS{^kCDCr(G^%1h@0=11dVm^Yce9d=lSaeg;dN5SNea@d z+~E(n`37EjGPcf{juEjdn$1_>$D9c!tB)bWHly5#R}z~<_mSkUAvOfq8ivprFaaBA z%N&`dL$=s7-20oP;bSg}!;4#h6a4a2=*` zX@jn7l;m;z)R$rM_kxR|8e20*%|xwGJhPO(JV0}v<1aWvG-N!Cqprz}rIeNX-R9s9 z%95>veaVd~E>E6Wgd(_exVoFF!KgQ#%dJQ83Sm%!qzk$`_Bdxm)zC_;+;#z+ViD2W zBa`5KmgR^NyY+Y5OUHYfHiwZfD{#hNXkm@aZnikG!~3T`$>xO;*3>keAAUSlE?Ta~ zoM;egk{Pc(GLKFm>!DcL&N}s>+!~y}^C~l=mulpj2#77wu5$%oeBbv-E{BZZuhx2+ zpDXSx*9zV|?Vku92j1DQ^-=s;?WReVLlS)4rqgWjs}(|-_A^~iHyfP`BA#Xo*_C9^ z)WB2!vsx}7_xKyrhy*gV?hjQ61o$ z;*i++ZbUn=IoayBQr5VHk8?>M*AOT>o7kb8g5gz`k)I=~g&f32{DNszgc$E(Jlpm@fer1?p)hL>HTUJ}2$vl>xXWMx?zHg}Vg^nTr zL%d{%kTv;SbDg>u?T{P(6t%dq-@t`%^{3qJMU4<1yf`v6WrvfoP{YNiU6az>_AeA5$(O$=t^ zBj%|N*60s5u7o~(4)IV-Q+W&B_sO?6vmK={6n>}3lI?b`9Sa-LCb;@eJ~8j_F&rBi zbDY}x^Y)@wYxI;}x9_pKJ6_|z3{c5|FxmelbnaiQavJ_i>s&g0`dmjHIGOm6&nR{{f`h^p5}l diff --git a/r/vignettes/developers/startswithdocs.png b/r/vignettes/developers/startswithdocs.png deleted file mode 100644 index 6e1f3df1b9b824cff195efb5fc629c5a5988ac6c..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 42409 zcmdqJcQ}{*|37@vPD>@LA}vuFQISv?C6c{&lC12J6%Cup2-zdDWn@PgQD#OddxVPY z?e{pZ>+|`2kKcd4oP@Ar8=U(e@bJx|Y@H^jGZW!Op(#P(}fMPvzL zT?;`_T-m%4-{G6q;K0AuTVB2 z^z}_G@0eMQuPYNI2xj7%$R&BZm%o14D(`Jy6`Gi9zE3TZO1JmYUiM(tST4__XHz|6 zxn%alHQkB*TeX|FoncB!lBepY?`|U=2KL~jEN!KmB0e2dHcwe(A3kar-|2iIB@>$*<`sHX-&lk6wnu7Y@FZ$1^sb_>m{`s2D*5Q=;_m8(&Hn#lx zCy`^i|JUDKjM|o{z(&Jz`0z}<%jCcoc{UndJw5N7RS%EN^Gi$bo11rspEZ$9+_Z6H zUp14<$!7lR6*W%}>lhe3$usF>IdmxI)8wUpURM6wR_`UR6cM+P=xAogwUxO_O@Gz2 z#}Wybt*mln>KY<0(6+u-XbGDgj&ix2Alq9sUfL4Ym8Bk;Se3I+z@6NS`?`5<{^S;ow4Eirg zyr-JF#m~-OH^5U~Uhd)VUp+I{9%P7XoFtpD6~8smkdKe=yv4v~)qKZvegEX|$g3z^yz-WoJ;c3V9b7pko%_<$)9+bYUYYyz z!+dGhMBhoT+D{b!!DTUU)y~c?`g+LeTEDZ#9lO|qwvHE1`IVcTyVFSAxN$@E!Bn~X zCa&9`==SqlZDye)&RY&`J1FFwy1pf>dL@KIt18^A)H5(}?_hgWl*_7$N_)cfkX?KC zuD^f({`w6YdM5|##DWw|O;3ON{Mowx`i&c6cvTd}CNncLnds>~+tSqDx3%qSO;M^2JRujY zm_jvB{{8#@f`S6E-&FsUK8;4D7ftW*@RLNTaNYWsd{-qTDw5@1ZA;9`$$1zR#k9P# z(v&F0_~|9zp0W0f>SsrlYljU=yub;*gn_Cx&{;y!CN++RXPd7p9n)7*?h9 z{rGCk*1xV^V6lO?S>j-ws#T_GWWQOi_`_5;pLkD^z5zXTk*a&LLw{8x7wQ*dxF9jCTyo5TC}?_~-s^gmQr_xlU2-i+jo5_Do< zapN^=qx+s$P{5~}XPmsgMLJ4Q^wzB-i*w^U)zs8pUa;Nq&Lv6_x6#O??Dprdj*|Q5 zUPeS5V%bIQINc;(yL|2WvEHc$q3WlH#kKYH-0_<`Ui4kQefwByYN}QJQrX&)Q1Ra? z#`E`QPjxXi4D(>OK0Bey_~91v@b;|qY8D>h(3fD>wEWL9i4z3 z=f>>}4^j9;RrQgnq0jH}EB^j$Iy^r=&uXqHqgz*@%kNuJOI3591-*I^`)VrqOzZ#h^b#VrIr_1U^&d7E^c9wO$3PhAN2I7dBLR@k79fl z9-eaYc|^o1VgOfB%Q#@n9Gson51xBw(%)Qi-#Ce$j^CW2S#oRoXA^(O(qtV+f>MU2YRg%ZZ%3S+ zoi_wW2s#yF5?pt5EG}R9r`^WJTH4s`J9Fj?*ST}F1f_5ok0Hz5Tvf9$d`hp7kdS)& zLx&DEm)y6drl!AOlgeY%CTX;aE1O_BT+hOiZPb1`D=#k??|xJrKOK^)mVd)2tfZu5 zzkuCM5s^I8A8f?Hw_Kyz<%1U;u14@%2R7ih?>}%rf4r-NMb=I-*7HqUhE~QWA^XXA z#g__!9kNQ2$72u7(I{$$t$b#(b)NcsuDR6de#rvo=tryH-*TG@t&MQ=qFvTjm2>YZ z#7LhV?=JISU0I6Lt@PqNb4HH;VRdyid)@rP!leXR8l%oMwfrhHyL;nZ7g2o7tgM@b zHLI;Z?-{%DWXB2VH&QZX&Q61C59v0A-19A_U+pp zxkj{SO}~5K^Xp6weB8Wkn~0d$<1QX1=lMg=oM+AH_`K;S?k;0g>bDqZq8Snd>dZ!xv$%_ zL;K^iqmO3Y8*5xHeF{IflRU3@qZp>^sV|{H262xy#;i-%Eb&4$lgA$oz5?B4D|5!k zdjOT7#O+~18bS`_-(_(NKW7$P!}{x=D;Tea<}H(Ns`2pQL+znYp+A2V zI5JOP>CDT?`H+%P>V<>ei+3!+sew0zW~4jPoRD-gh7x_w+Eh-d%exlS5Kv`ecD8NF zZ*1rCj%j{;+_+ejt|1`KCXJf!xW9Hoso9 zaiecN!i*)DnVAXPFNv~#gCGvAgPxwAwZk}Ey8bD*BqU>{WpuCW=@wShrm*^KO_Yul z@WkisC$EXq(pl%V7270vHhtj?;HCb?m@98Bhy5&sQQD6pF4$fc33&O^2Zx8I@Ia8n zBYal}fC67oL6cPyHZ7E?vc^?lX1(I zEl0UIL(<7t@-Ge6Y9lw)JAQobgHA62*(L8dRwivMn8;JM=(dGUT9s(>6QI2;K)My4%^+k-i@{HCX^;$OYe z`_+-fAEg*x5%@wRD)vKg)d#CbK}s@o3aUVK9YwYrU3UH3zoe?j(L1H#d=itImex~4 zQpJ=Scyn~0O@Z+9J+jub)d{~b-q(EZsMBQ~>rekj~56U|6IRhb%B=u%AQ#>qt~ z^jDD)jLLWy(X#VvK5z<^!E3!V`OAZD-I70?S0cA=#EPImS^IvntNAg_SaWp@qgtsym2tK(TMMK=ACjae&>Y$ zL%uP7n_nIn^*y)?ieZN6;|FQj7-Yk67aP9ts=lxA;F zkE^KnzViC|^wc+TgP13GnqoI#&^`gs2)4HQ=M8&kN>twWljiqjJhwweM&_Q4O%*wT z`7d|@UG)ViX+8)Eq3yCCj>xXx@ejyty6!EV==ty8mHcr0{{g4_zh{5{pZrOVWK3a< z$nqaQN>blkmXBRtUXGSc&NOUE%&zy+U7Q}dnJoVkXZ~q35EBDt5R=oi%$DI_QK$I$ z=<%QU2X~Ks>{sy@z$5(CU5t!sZ7LWsH~*9nr}Ope8v0sO({wocJ}t=RaG1P{QM^V{w*KNDD%rGUEKO)CzF_|X}V$<2AnR?EqMTH zS=%`j1-(*mjyI$mIk|8wexAeR3@kSNnk_nR@&564x!^Na+x_PinH~E%x?P~*2c96Br^x`Y^>s5B4W5vx@YpYJ5UU02DrJCak&J1Kf zQOlm8JwMU=_Wqoyih;j}N76l6kH*HE6gPiHVZcp~cWdq5vxiD;@cJo1K~20zxjXjr zi;MfNUNG+ypy8zJkdP1sbClC;XqP@%U62z4@7=(zLA1)_ z#4WtX+8lI#uZ)Zg$H|Y!RqJjW7_g5OTa7&Hvi4)(l^|*`TYS4-#ctiQrRjA@e}DgV zr*Ki7Pq~4Cf${k_?C6WHT5Fm?wzoJ<9uUBYpJ}*da~C8 z2$RGKvy6l!Xe?q54*Y$6ePnO68vU|m-@bhbVIjc(hfbf~fx&vJ^><)AnwQ>>LTkcR z&}k8Kg>vUXfp;yhq^X&h{Lwsg(Ub03S)J^ExjH@%l>Qgw+T8`z=k%EIzSp?t*S~{yW}0-K?fCjNMyt$O zqC`@^U-b19Ir?a6H!(3q$#w^G0rR>3`enS0foC&1lO5C{91VYP5whUPcb6m+SIZv` z_^^@wz+aRI>RN2U*vQCxD-Bz;&ilu7XN~Ecm;Z{BH|edz4BO)DZ|{ruX9Fc3*U5s9 z`W?8ikx(wQI)U$}@OHPi)1m;{F` z@|Uh&-At-GX_mec{t*#Bgkrm$?%m@A=6#4u){jeh@7}$}Fqes*OCFoM9L7%V=d)OE zQ2(;LzuLcdU_f4*Ps*~hr>AE)cNu zi7-$GsNA(@&pItFEqxG`i;s6Q`Kjfb>VT|~SQscm+tgI^G2c-ZmgbBP8<`oobk}1H zY$E1yyr%^h3V?lZvmasFl|$h;efspBu3|pt`QA;p^!4e#SD|D$O~0T2lBPzxW54j*L_UjLeC9#_5B-n?Dt?(c>S)Tg7V7aZ4}yeM7F`E3#!?- zwt&7-LhOL(7OhcabKdG_K>4z`s3^%m{`~m^k?RWHP3giABQy_EA3%2{naIW#;6_3$~}K>@h1{IObYBHT*SO?agi9>|gJn?977dVl~#b9k&>_ z#x*YPFeN1=r%uIs4E>+q6S)RWB?NtB0*wx>WqtnqSwZ#j`3o1odwQV?9UF{c1vHBO zWrkCP%d(z{iK(Nb;~hk>@zSN!rr+P{+&h3SE1aU3*7Nh{W?EX>958?7b$*7CEW-l> zJrlj}Hw-Ze*zF=3fn}gw9XfZey~hHB-tE<^SKJ!y#4TKtCVpurN5`D{O;_A~X$Hf1 zsGPU~x$*9s|*-@ZNn^1S(FGX^OpBlIT%ly(yu&89$hr5!dlHg~?i(-&x)?c`A;Y+#(BP6tf`d|ssl3?f}kLS8wn1a|8+;Vey@3y6S zdhR*Sa`EC1?Nw5yfF8ONQ>0by>Tu`?7*-e_EITMCD?5?l zvO-0E2>c*^N%F~8W<>V0^Q&{?-PKS)Zi4FKGDSPgjMDL09NE2lcjoQS3@8wuJB`BZ zzW)CHip&vFw~O6gzT7`BFhKYHEH$-^3R_cNjh5rz4dl6vPe{<28ExGV`3uy17qC_p zjt>Q?9oE#;yaVwt2enC6FW7y-_Rp8CBD|}MV;qnXu3R%RG1<<{@y^%Rw-U`h3j-zX zm@(8;pv`r&e|}IAsFa7{;f!F5=9ojI8Vag#2~)%On^2I%24=Iym=7OBFk9(@>c4$s zAo)02-8~>#d~fd^ej|N-1?C?>P@MOAgaJ-PLT7(5^FE^IxwEUHqJkLsA(?>pjw#=f zZ^o2o)}8)6b1>h$UyPKh?&gx10BxSc*d$s5@ruEWJvK-&Z}ydfb0OL3&F#%0a zU1)Xwicw+mu(-K^^D-S~?7Pr227%$rOLOCT&@f4vFE%#zW|nRxP7TCa*-4whS{hQ0#f+;2v(dh-I5F2tvSf5uR~Ri&Qv<@nywD%| zaY*M^=DM@2#}w1_LbPPYddWiX7JGh7>fT86(dUz)S~7lXqy)Wxf9f)`db&Dae0+Ql z1gsC}5u`947PyJ1-D&hW{9OCOkEDrzjf)dKVn#%DJ18EIf)O#n5)IYGF%@aw^4k{_U%ES zZ*eVNbms__RSH`iisP8+!T50r2ZutmK-NJU%qj|I;K&VaG4#J`e*DldHZjpJciZsn z<;#;0!2Fnm(zi_v3=b@fBrmc_2n~mGKz}94<9}9%+1Y3$E4-=XnA8{X_R>9z{{H>@EHw1Qs~Zu|zI>67n~bJ+HOAmOHeBYsvRJz?1Jnqg;VmZF zHC5FxlKDZZo7s_<3wV+6vfA$eJB9=c%d;0RSaF+aAsc4Bd2_~|;HG|xCa6VRy?HaB zZ5qEiD>HMKw6rueb%EmobW&2kIu#Ned<c0)v_=hA)nz1Ut(LlMC8cf!&d-hSpil~aCUru z)5$B(L^oMHD)4zm8KwJoVj=*($W>k4Sh9WLWnZ5(00FQRF7Mm#lB;?OkYhI?o1%D% z59$jybl}Uy#l?Z+-q4~MbGt2vK2a08hK9*OE+kTw@!ZrB#>kIJlQsfNX%EpiGNRIx zC?RqSEw%P@9h{@wAz;MM+7rRgp0U7(W52g<_2coV&90P(C-#ZsRt7p2zI}TY_Q3#* zx#wV5*P!W@=Ok`yf!HFE`S+xrn<0^HHPTEug;t$x8$SeLl8Q*yD9Wo39|s`*m_+^5 zTBX=7>secKvn=%6<62HLLB`#s8jx{sahhCPpM}bkEp@b~V0Kws$!`X%NyQcmTqvJ9&492DCIf#M|4Z# z`-+P7uF7g^MjGBOs|&A)0GvJc7BUzf;7~7mcjR+J&s`@myc-=0e<% zA!;Dd<_>LGzkV~J0*Yw^;bq76fU0_^RdmlvjThfMIU2@i>cXYi}`US(ur z%2{PaoQO~q-r8HlqI<#h7YDN+aE&o@dEWc@Ui zG&QN^57zGx!hZ6_>Ds^DIflFMeQ{$|)C>9R7@PC4LvxeP=4a>#KO7B-`! zZ3e1w@S+G;v<$MELra}k90+@-6b*Itt?^^ua@iTq8gC}ZW*IbsOG>&M1glea)ZoCt zLs&)Y2%GV)G|6_K0M%zJS8<&tDrvPKW$gR-@gw<{{(d!xIs{3(zP|ova{|>YcpXb8 z!$k+H2NcgFdm*I(*6e$6kdDp+7?Q%ZnMY0!HAT3>y&5srJZCqd4G(MI2_aHS3qGax z7^CwLfO?V5?+W;K6K!f{VCDxthw)xfR#r~tRj{$PhDvgZc-O=Fv+~qj#oig!ng;v? z_$zy^07INvcPW23_uQ|qdx(I509TAi_7=0QVo&s1;@!h7d#utem*@YA*83-_eFV5C zF^7I(B9qms>G4aKEo`=bG_9fKjKI(7NV6^iA2 zq1;1|+D~wPZfjFC+_7fd#WOq!gsvHVf;-?`O>m-1R;lGzWni3kmE(r>`36&Ymcutl zqY%>VW>Cq3dN4f_r9s7#>gvLhR8LIeJjCZf!hd<8pq3vV{dVTGdv< z?ssncbfO7FE20N&PkDv$_`)aJpV*I&PW9i93R1m292S%zabUMi>lCMubv&NDL$8!%laB+3Ao zZ|SSTs^Y#UkJemoh4UmfQ}Si_hi!KyoarpR>K#4@F6@I64LB+OCWK{WpLLD<;wrKVIA0W5ZD08Sj zB4wEX4x5f;{~L11NUSyQ%^SH$mI0|TBr{m^y4U7-c8G) z`2mV~Q~b3(CDI~3I<>Bfh4QcEuZ;^xy?YiBktSK^^3rPie*I4ZddjM*vFO#cd%OYS zNsfyHQjOxD0KC(wc(~=o1>5wGW17WwTqI}3&)`VD>+EC%%&0A(gG+?dcKFmOsd0WU zwLg#d4y)E=#7`#Ce|^h39ifFA4|D7aoW%O6x<-3LQ&T?>`yP~^XssOBHkfkS`YH(F z=gs@p0~J&6+7*5B)t1yLj#u^)CZBrrMD<5`4Sisw4vNPDEYQ5rN>k;{0fGhcP%d%E z?XsO?C`_Ljl(KYYusn^zV?J@>ntgkI@^nx{X|ZAH1#lM0Rot8->AB6RQxa_C%?UFq zeA`WX{KiY+yLZ_Dk^cUzW@3DpR~}t(X))8g6IP~>rb_dyy}Glf z`^|WMB#+_l(^{oIr2ULgz(W8L=sz9+$Q9k)-2?6PBYFrWK!520x08^Y1Mi|WirBZW zaw)C<>v8!hRe56rI~ zDES>_E<)(B{^z>v*17gNoiZ(8tovegsBAb${EEcbGF!cU(w2u1D!1mU`ohy;hNB3_ z_=^LJdWPo3^L%{05JPI}>#Hzff{wc<&`XA^-mX$EvN;9vPciVj{Y{39Y_fc<|Hj8* z4z$P3D)~Zu_3y6obRSr^aU17okzRBBHU4%vhIZ9!t@aBS$H%Fn2TIRC$fFpruI#;# z;OX&GUpBVf3I~2N{mZfx+f*6V*Ty9S-p{{lLpU-dTLda$-Pk-06QZ%W9s7k54GM^eAboYVamrI$pifA=+eb^Qq&wzxa5AK5DB17y;~|A?PVaCWh?&yvNO8Dd(=UIY-LzcaLC- zky<{%D&!?VDpx2`)?9%Bm%?Xd%RVPAe3mLIU45IJoLpId-`rovJpEBf#BD8LqlXm?LqxAF#b(+wAR6!va%>i2 zN4x77si~W$Zt9j#yKSK2G^pQC*spWBc;P1*1Rw|$uKc3Ha6ZBnq-91lzLI9rFMRT3 z6Dgz-?*=|T&s}^ecs)&#)Y)nct~l*9F*Xhir_&2(t*WYGId-h7hnviLfOb*r-Onk0 zhQ(MWDpP1@m|z#+XbYcmBf4Dd)I7~GUS0+IAPpu|K1zW`xJxc!*@>N3-yn(R0gfiI zA{~nym0@N^4wnzfuN_b#q!0tfOc1cv6D&jFF4Eq=5XNl3wz@)QwGe*TMMtL$eeXbm z$_`dl&fh&fM6_|bk(9PNO#3exT1=4N9M&A>{%j`@2B3j>Cvj^j%yI$8jK5p=9yGLN z$g9NG$hxEEr|6rL<&HygU`Embb`- z8fPFFkm)Qm*rSo+XiCkutT-dW!@c2%!_!61Zrx5MK@lq}o_(j)J@6THK6p^?qK0F) z2fyfKz$$5u{i}>LA;K_dn5mjZ8s41R?+8K|bTX)&*3fb3cRmV11ms*b=gtFECEJ5Y zkDlg)>!fYaGd%pt=k(TrlHEh3Y>F$JKqK;_)QQo3xdmpfL#wn{*-2CCD2sBI?gk>7G`mlCCtRn+fb9db z5ZiFR3gVUfWPjy_@nU!KieDNdop(qg@rjACz`%5Zj&BveJ$oCxEh{&-64Z7lfmg3q zGb?!nBs+M`%*N&{Za)`#obl2RLvH`l0x zCZur?nxq^bG%N?hy|XN%|6|8&qvI5Q_Uzeo`WQx4-@rh8JV|$rjEn{?wY8&3QC0Fj z6b10io58tY)=+=arilUQl@ejFFboF)!8MGQK(4bfnk&47vkY5~#no2S)=D@pj=Z8A z0TpBe^`jI9%?;$x(ggkdP*-;yrU1+dfVNtPKV2m$=QuX)Jh+$W8yZs7?t&k%-gVmn zetEM+;13O=24srr6O{6Z7vbUT3)9ondqGhtm~pS39lG*(GeLjO^d(p2F%}k_iM@cP zakb+mb6wAo5}_Qk8;-EesXrj~)dX&r$`H`!se7M3fBFI_GkHKW>} zs-ZYe(UN^We0fz#>IK;{)s(IfL<|$sw8~2V;pbB0i@d`PWbWcqIH!(Vo3%P{xBddY z;SC3g2!L3y&#)VL!nmL{MBhd<^2oZkfI{dHf(aK!1VFml_hJrG1N&HJR@PJSB2NUD zBwuh|Qb~N<9)B8vP=!4B+eY$XXnIrx?xsJt30M=QFwz?{iDz=w^3A&UxwyC-<;cs+ z>jNxyw6V1fL19FUo%*H9JyggePwVBeJm2pRZ6e0n2MW=vmzH5uoI-M=>zpE$A`Cvw zu*R;1o&59H-`l%o(bUG$a*vXd5(P8v5xT891v8Yt)}qygsbMMt`Kq&TAwr07gt72W z4x&21@?Z`zyv{a#>6CTL4O z7rVK+-RrH`Kza($)t(^63C&gq77u!`HfWiLm)B)7hQk9zq8vBf7oWc$uJ$EJ^^t;3 zUT9sqH35e_{QSf)ZGF4O$w(evdVaRktO@7K?*4uD&y^Y)8YJ5Ffk#fh8Hm?g=T~B zyagS8l9|c*@bTkV6g|mTfFhtz^^TAGBQVs9v$L6ss)djHH%5{h5)AtxuvP#>2W8iF zk20S;xeb{$QMhu*IZ$9sfyo@kH}PMU9QzMX$-L-Or{XB0KXbbWAxU9e2ptm>-&fL6 zv0$AYIfi>yXEI!9?ypc#P^g~T6?wq%WZCkR*J5NB5R-0i#Un(g$TwsPwhR2&14Ttt zH7bios@SOYb%O0nR|CV*B3$+m642UQ<5@zkVJHNnk=H((4%nm~Bi*J?W1^C59l+(07i`>ufV!bk6{x918Ch+!hcp^dNKcH@!_q?Mh zhS`9-ehIw#TfUiA6=}Y)*&7c@Z6G}=<(xazuEp(dAc^)vkEz`}3aOwYOYg~~1iIH^ zcMhD8>EE5S!d>jgFA4|%t|$4V$t24j{nb^XMn4mY4-xgj@%4}fugIDfqAs}MWTtJf z^%|Jvo#yy0rSpAM%WzX`qq)Hf%j&*o6ZfEg>PaWL=ifhudX)eF?VB|fjh_bVLiBK~YYkAeq~VOrA?i{b zajRa8jnUAP>45u(fsA8OZVw+mvVLXOULN*0x zw0$_tc8k*|@UJIuL1IWi657D>v9{JND2PUIWm*nQ92@_BOK{`&@Ky(L6Mx<4&{ zE=FR*51S5zy>t>joHt}23L@;Ri5Ctr`v}P@!Qy&wE?||B-4_BT8Pn_N>}0R|{k>oh zh<7#g@EFAuc!UpuYWvdiyDp>C1Puc8JjSQ*fue$fa>HMSA>odeK}nRZ%&Liqic%2d zegV9PUcA5^sP}@a^Li1VGpAlHAk>v<^IKKD&}s_`a`TQIRY+5B$CXc2&D{zSqD4jU zu$Yf91i9(6Q>6$hl6>dqUMXQ8y^vou+mUarlF_<6WXS24sGP z2ijcYx_?81A`Sl6J{R+10f3r;;r03!E-tQJ)NmLCIrlZc$NDyCu=w8G3trRXe4xUVR6_DNvig z46yAGC}jLfD3{(w`~scZw;uz}ky%Cftw?R(lkwUl+_jTH`ayiPn++6~d=1jbLcelH zuvIZ^e%{UzX+F4*B0yt*z8AP-T*hIX12|Ybo%%OgD{?gDYB>*K=imS^v=#D3&8JTv zpuFk85yUL<*!)^P*$p_M{Nu+h(00j5MlN3b!c9dfR^vBP5V$p!kZ^P$nSkpqLv=+H z+(?i%#FqHqzkhRC{k(}#^r21zu?y2O1@Q? zMX?}nkc&ib-rQB?&$N>{qrs}X)M7LuHudg5DvbOrOBkM5IK#wq?E{TvkBtY*iNlyPHyFpi!2DBMm+vJpxz{HE4pfE=4 zf2bi!i&@Ip_++8&_zr*$;vE1m86}CvnIVI8q|^uFov3|oMqn~9qSz@2SmNMRPwE9q zAg==&Zbb6#8y#eq^#Qb*2po_~c^tghmAf zM4#FGWql|x=Vg2X(t8K$LSUJ)#^~~D`6ebL4wX|1Y_OQ)Q>z62Ak{^C{P^)f7b)f_ zp^QX_<@u~hm(|iHvXCKUgFkU|b3^0P(fQkbrRUF|9k8oOJ6k?6rFE2L(EUH}NBpVV z2>gIl%@WlGQpmxfNQ=&a@k)38UUZi=bRC^4ANse}WBbyz%KYG;YvV@Z)|aCbkOn7B zM;90yOdvKMv#?`*iEmxjN_RgLvYQYNjdWQ`tcm)AK2y7fxEFj@N}}W2x4Rpfg*7wN zVz#{gH$3>WQcrQ7#h%0#$Tq=;IRFZEGfZ1eRh3OD9dY}h#8!-*w=mnDt)gB?G7Mx* z5FS20B9fBZ1TJ2rM)Uv>?0t1L4%VJt$cJe?_L$Ek=mWkZ`zX*Bjb;1V7+Ga#XXe0) zSm>b@*5p(}E|YL|cXw}dCi8OW*$(Z)zkjE#|AIq9;z3+WtR=aEClZZ!tNyda#z7kw zCHdsZ6IwcjPADyCRX4l1OfY>(w6-)}CJuIbOgeHK?l15Ul39f7WX|Gv*_xte5$S&* zucRLea~6an4#oNNd%+px?w$q*KPLCZj5@KIP}woFR`_osCxJH&>biuBA&Qz@%mL5D zn4JJl5xo2d= z6UaImN3V7fLMypT1xP{yc5wg;#6fbpu4t%}WEcz~=;;TLD_>lDwNNv(Lj;z!k*Gse z1ve{wCmqyxt*ta_dB!qbXMXqfxxr+LF=&X~P>WnL`K5V~?W53hEO2ja?quEiFSDFJ%fWA;D<-FYw1i~u=?o=+9>3oS~}sAJX~wxlt_vf zMMd{Rjf;4YBMq9{r62vaJME}F)8!2%tnH#IU27M2Zgd|3r$cwaKmQ5){KR@4AjIuv zF(j+k(b9(K>gSw?_vBiLy7)Q^-8RY5Py=E1GY0h^u*8X7iieOOf@{yZySYtZRE57R z8~#m>X+&S|4c8xlr=RyF-$0^(E>vvkQ3GhDs7g9qq$ITv}*%T+)QcJfA(rQUA@2!pdsEUXz73`QJaHAf)}t9YJyy$ z8h{=}OZ^mkc3X(FGBP{sQ3E_N5MkRz4d`JGEdnagM|AKYYlxc4Fa}x8N@jwQGN}QM z(Fe(FMxloa*k>c{c0)iw;1(i7WTpdwP$Ohd|ksfPH8^q!$HT6?uIw+Vi zE}kP94j%;gPOH-q+v+R3>oUHkDPdB<`7{M)SbM&F*0OT3D`KmZa? zBm&8}hRAe#L>Rv@Vob77%yG#Ov-7*tYFTBhruB6+Zd~B3dj5@IO7 z^=s(lR}pU0M`fti-Kizxcg>kPSIA{QjN)tX5j{LWUarAaCd(4=Pan%&65qhZ_OV_e zxUt-=kKZ%O+JbO#QtoerO0JQnuO;bF;t%>j!47jDZ$=!CUAiw7f)(HE;E5p?7%KqV^MtE~At7!g zbisP`2wqW9u*-Qc>c3e4#&2cIW8p$BrC(kvTsP9d4~^b~AB9%waiVX-uvTp5LBkA(MOQZclj zy!ElZzOCqhhJGa0Pk}x{087ZqTEA(Nkw$o!o-EAwtnBP(sN5RFCXZgYpaw{&4}`2* zR}bTi6r3Cd&HEmLv5SF^RkpS&jPbk7u4ZMfa19E6xVd~&`Qp+^r}o0fTyutq=LR6X z?~NDmq2sztUR&7HeWRmnph`iACeg6_delHXJPKrl#{8kPQ_Xo{kXAo3>+f~v22I*W z5$t+ZK2L!;>#(kK8saSfc+0jQOffUqk&{{pyej&EQi3OFaRo`YbGr4KGKY6ng0T z2&jsIai4%%PWF_A2A5S>pj^$lMoL?D>`-irV}Ai*GE2S4Mhc&75E`}|+gZKYVR$6Z zdwR6_?$4$|ow$NwdyJ%eS~U&dYm7{nXHFO|p(1F&&PT9xg2Jms9mQi+UG6g4+v>5nh8w^%0`fAj-yK=o7t4&Yh>_7GJTOfjKF0TKz3E z`Ps0xVUPSt;6m6WxW*G0DiU|^zD7`Upuvm$x=tlsaK&JK6pVnoSLcp-7tI zbq5EB2io5n^QhQ64d^Woj=gRN^f-;S;Lr}y(v*T37jX}Ad2ohkp!AcO&}^Tf$FE@( zSb#*^gC~-U%&-&5!G_U)3sk`Zo-O&Vz%6Q#s>;cG1JHAMOvA`%jIun(<0>*!nF*hv}~PUJ~>g*y!n1p#8QWvX2YdG^-H(pX7PxT z9dmW>IH`11yXVIC*X#V5G`1W+Gk0b#bT~1-1`*|3WZo2>cWOJWq_+pz-U?nciFG?r zKQ)N7PZZ-krK?`1u2wQWL=u3@l9G}GsJUR!S1kGaAy{vi^PqHU92hd>$w7y!{y2p!dgKJi&?Q+d_{+Jan{sDd zzPTA{IE~?heSmrk8G~cEAu0qS4x*Y$ZiaeGH6T16L4J?IiAG3+1Iyyiq2w#8Wc+?J z0{%tLuZ2Eujw5`0D){~Jpu5~yBT=1dY8!$i{S>CcHLN^AXQ?5dj)I*a8B@F89a&e9 zH$17FDU4rz{K<|3vTiwW?tJIu~c9o;A3;luU5lL{-wtx8da z>QC-m*tl)PAf?4RopEyEwvNsra%ToJxCZC768;>7kwfswA^|*V#F?CqKxnZ*?eLF3 zN7q79I1yk0b_v3ove?j9Di!8A;+&kmXdg4Kj3hGIZAg_6?^y)-nh)Q;sTSNgGq9L+ zy4|I4@qvpQ|ArP87Wl$9Z{$JWBom!gi?-cPN?p!NCe%&N+@wTKuKXimUz-iSEt4#7 zfs{IR@=qReA%)_3&M}npol7so1_9TZGc9+*U+3grw+4jVO)wld zLHu)cePhb4goRy65GA7-5)||iYSu}l6H<6hO#aNi06E?TQPQ{RNR;EGXZ_AB3|)3x z31sSz0)PbpppgJ7Fer$en7ec67$lW0+KP&hcZOVAYg-)cjgTsG`~G1P7Q-CyN*ASD$`wX}Gx2rUuCSsik%RarAPswE`9G%u|_pkG<7 zEDuXw_#i2~^QqesIRKzfQtj9g46?|c!R|gX+TG*r;kddmOg?eJS0BlHZmc5v>f7#- z)GD;P291RkKq?tX{;H~~YMLS4w_$}f^_Hsc?y@$^D+8;WTB@e&f@YF6$BPz- zSQ4lYF#udIAv#)koG&0GTK#BW;vu&-U+X5V7Zd+KWee^DurqOc+%8PAyJWqHP9D2JotiJB~&7z0tOi5 zC&jTtxOhL-O;dSY zcJACc=mJG@@4kI3SX+u-B(o9Z!uG_^IR8GBtq2ZP=@7Tqq2FJzw(Q$Ye*vK}e0+x% zJP)9a&r;W^?IMINj57G2^1&BpJM?Nkf35^WnGVirV9T z9t@<1c(BpqZS-zHXfc_YHw_l?K#KQx3QbR6ALX7sd-Sut!6#320?R{YYVF}x;>U9Z z3T=MBE(yY_e2?!kO(dk%_~>hsY>Y3QifPhD)sEikw9y#j_RpQjgbkc;tHNWfaC`ZWA9|CSDU4$t)V@<_IkT-{ zhe@@nt}Y81m^RlW_j|5NOSh|>)`Q8hA3ydU{G0RstT8f+uiH$v|DLicu?-@Vlsg6I z33B25c$A|XT%w}a;!bB0wbJEFx@?#1_4M^OfMpI^V^qngtNTFVEEyI?sMpKey9xb( zKfgTsk~>rsUyLs7Lcy+q!r0ies6dOy*g(FIj*njt!q8D*d0g}UZ(jF0J>w`71A|xQ z0!qLAahh%$M`+pgZUEfej>sJul$d}t$|$dNrT!4c9l7s=C}x&Zt8-U};3P!&pIs#v z;Ce&5nZPi+tA2&x6(SjdCycT?Ijva6Nt*gr;P3+^T}D~i132|={2p4`SMkqZyigu9 z|1&n`jnPY{YY11=4GTg8@QP|nr3Dw_FP$+(|JF#qlEXFoO}4whv}QOQO|h!rpEmsV z{g*F$@w4#m#Ukd&g$h=2{gT%%^`l-|R$K$h6a-d2d{_R=E+#!oA1f=IUANN<0|-x_ z5(A>J2!Q2Grq2VsF8rwN#=SR^IxHl_gfX3x)^SP4r`zBbe*&!z< zhj~gq?;+RJKv&ld7PSs4!0uHd1Li${(w9y?{&mP!v02(gI*l$VU#qvD~PSCBh{$dtu(igp&Lb(*V%%37a@6ZP*|+DK_y$EpY=_Dc@jM$Mf?sVJ?V0zr9Hp{7x39$rDiyr8`W^h zb#MC}!mf}p_rtkMUPuvz$=lp!z2nQEKt?^(ewLng2<7JzF|ob6x)FG53g zaIg{H<;7Fcd_g=I)DP+{{Thv;P+00O)QqE78-}0S56d3WRE&QeDQK)%_ z&LQ>7+>Fdo4eJaep^4}uInImF7cd1`yC?CSpF?;kQrqv=ySY`Ow+96Q>5|(oY@QL- za&q-Ddm-kx-xHeMVLWVU?6Bw`{nf=gMpKKmosEUK2jpiX7540tSnWoKy=QLD^;VL6 zTpEPoEYlzSBo-at^w86D3zWIXIE*ZUf(HTRE8*Bs+%XFQlGDb5z{K?QLuC69p`5Xy z!xNl1VQzL-p}N}a0@dy9`Bs;wq>+vp`<_u)bnzJEkEd8(H-FL?Kutqt8M5`MU@~t; zq-Z@J&4=YV^5Gvy>)id3kzTE3T~!(~69Za(9#pMLv;|Q$>pyY}CYG(*uLKw07V-Jd z45p=+q@;|Qzr?Sd%aTBQ#Pi>LCLt-b;Bj&-1=2^c?kplM-rXW>0n$p=1E6&lvcPz_ zTS1%2SV}|6z@I;USaR2acZI+69x}LTUO2-TWwF5aAY=(wc^`G|roi8ON#dWJ@7b&wU7g!|7 z*e0;I<~HDgcPmO7f+-N?n#x>UPO9Z?gXT_dnqnEwreV=8I#xPm)p1~Sr8vgv7E%J> z<`1BAMZ@LCRTjneTo*TLpckTOSqlH+{QNtx1A}k?%e=P!{e-5|i~?yJBkCezZk|Dh_h20Vd}aj(e8zpd`Tx~kbXi}f>$g*S@SFj;vIUfjQDkDS>c&_Ppmz*t;iWPa|< zy0!HV?jx|x$mAm;(-&-hy~F&>)GnuVoM~06jc~)$>-t_rIai>jaC;wO_Q6Xy@m`F4 zwvC$`Y$scg#nqoz%AeDmZQwk5mxFC)4)WT0y?HE%{1n z-F+1%GTsY|nH1!~OvPa01fSM;Z5ahjR4?n-QtHY*C=S`em#aK56kytxDz4|Zy z-?ZRT>xU2P0i$trcp&&a#uhL#jbEZ2{OGtSNeBctoxH*@i;$%&>JqDit-lAQU5zkx z4}xWQ%Rc-0vfFg#XIh6TXoi;|TEP{00N+{t?L7)K*V;vNPF)~Ng6;HMGR`>X)%JjE z#ezI6V#rlPmcN9ZeKKwf-bg-)1}tryPaC;AFfm#vQ{{MP0dO@jrcT)2++GsSxsrn1}+X{;v7#n(B#rD>(|A8I<$5|vV z4eI!BlQ>f^~G55XZ$nh<8=_@#8hUyG!UCxX{!9=%BKJ zI1zO~|3OY9(K)EY!csdus<5!QcvnCXs`zzEVR&CGEZ>eZU%<2LvYoInO9X&IyN^y` ze^~+~z7jkZro>Tr3VN3xjcO09zqL4-@zSE~HF;I=q?^EYauXNjYA!WMmZY{*dKQuH*lhRGZ9v2V!oa2PA z%C&AN7*GqF?4(~y$IIQk$?UW^O|7QZ$>1-RbQb~a+#5c!A#=?Edfx-`ynKBXngI#k zIN||)yvOKL{*ZfMTrpA_i*HfRcO?U5OUA#nJ@LHi`?c75FfGF*x5;+D(s(;WHBzR4 zGI`S|Ea-V1j-A@C-@g;k&l&tFsTaoA-%{|;e|_WS`9sndX9B?uJmcc@d>alv#g$gW z6Fq&a?T7%Fh}Z$fIbm%OTuQAH{ zP|A=YLqal3Dv1)2%t;vvTZJ+u%9t`1C1fayO`(vafh0<(ka;N8?{$=YKi{=}&wAGS ze*bz}`@V0tU0v7p`JA8gJdXEtM3%0O7+3JO4xKq#=Hq5RExYyXIUWM^7PlFuLxUbZ z>{9(Z+`o`$n`b#WBX9j&XK8V*xYTWmTl+|GQ#c5@dBTe9jF0;gdHM2mgbFVi-3g)p>9Li^=$J+M z3`F@CLN2?-i+ceBJzjO;)RFST7wg~o`t3}>?ePVnQP4+6&92W~*x?E#w%gB_-p5c% zea^Dq4!1H^|9SS)A^Tw-j>2II_77GhmIg~gL(lwj47Z?=l!N0D`KMq-d)Y6N>6Z=W zX4*#CZ4z;Aak$a0$YuZZaGsEfzrqKMZ!=(Ae?!BhvAwPxJsrNT{AA=1mn)4^TN<@4 zbL>G|9hEtsr|^{Su=8lH5WvJdDD(OKBXv5FcXDaJrA{x++Zz^kxK-)479%3kzS?w1 zFDRX0YxJVHxI5dfRq;=aiJKqa++Lp?-Gr9CX8L~oxP;@F2CPAY22>53xDLUTHXinc z?ahQ?=W~5Ro1GbRpJ!x!MR}Q%a%Lwzp|&L!6zfiz&2D$|nKQR>63#~Ey^6EfAfr)- zA#Hg}knHgjj+MC<=f)d>YJHxSTO)Rq$m~cAoRELQ)Yz-{tJ1f*58kb7<>~Ww*m(*( zc+92}>A*gtyZp5oiD)z53?bt1C(rN_0uSn>opjvJO~@&+Qz@5vww7q&8Z>Me{a{=B zX3aKIX5@J9Dj%q0c}@xXRB}EpE_|{9z+XdKyJ%gj;>9j78M5hC{Qk9yI=;kp>Dvy$ zJu^pDu2e>l5q4$GFFioErRAkAoP&1IzIDp?#8F~;j3}&7TQ%EcPFpZ<%+dKmKz=$o zSW%hgy6(d!PO>#LGx)jsO7+gO{&=+KWQ%_q zj<&Xf)EpH+1V21H8uX`%7w_Krf(^esws+AjFF5MBzzb_ohv?A?g2?HeW}l5o}IGN>S6QRghYF(!J4fg1o)YozqiXM|vs= zc%MHnBPZr11Y6QdbndG#k4SBa9;JD!R&uOM79tu>32$NBu!9vg)yN?>N0|puluvAa zPOlCgIuxPwi2EZh7$7n)9_-p&=-WtxQvo)|?>4EvN3LgPZY&IQ^##b^&S@)d9><&* z1A(1Rqi0Xxl_d0;ixNU-iFz}sl+r}12{`m=d#(|LC^i7{hYqdzJZ53`#c`cVl7bRy zhGICR!RRfdH#<^Ua;&0_MLdDCm~V(Rrc5wi{UdFC&;Pr6QZypzs7dL^j!*#z=IW+)ba&o5fc_g3eZCd7-?~`bW7&+i~VY?bg7n z@()5D{m+*$Cs(APMF+sBF;uP8Ci^0av7rgmv_DZ#&65iw`XNy9+W~Ee{ocqIxmw1qf7+=2h{(dkp zjqe#rm!nD)cu0sQ+Ta=X*FYz|8n+9(8i(}*9bXNFc#^q}Ubfj!p1kA%Hlb6dUjU=V zi%^e%%zTJV?6MI%D_QA&q;oW)f$G2VU296FItr_KUkK0Zd}!@=OLk3(bZgyjQCn&W zQSg!ur%=pvFYIjp)T{a`jqaXCo%FVoO&i)p(fiWE$nKexoGfZ!!NjUN`NvrmaMxNo zIwLvjw`|$+@a+Bc%)9?;0cMXt>uZlYSXLg7*!JyBpyhY?`)~aHd(Dau&(x51Sa^B3 zR(o0aeBSZ#Mj~y86hkoI5x5P$JL%ONs+;C$%o_yTWnCt;4=co^i4#3}tgkH~H=Sl%qj{YyoWR1`lxhLHnpSy4s|Wn)_jWljF5&)?C6Bldf*$$dMB0h1rIt z>x}L&wdxZiHMd}Whu42ponM1ffBk!WXohY6kIP}_f2Dq805coA;S}Zz#4<^nGVneacfW*3r>fis>#i?LMic+#v39QRtu3s;|}zC>@sRLUSZGyUH}Ep z&DEQP$xH!C7}4mWMkNVulKp+x$>ukJW> zXr}!yY@Rg~V8%&$0Mydg|2W+PL7+saE5~gupWwe|PaV!BS(7k;90w6m_lZH%fBLL7 zZF2&MfG>o5td4foO`de^p_&<5ELqx;eg>1DdS&^%TZxG^6_Y1V=CTOXDH|D+86MT+ zQG4bCL?DMJHkws*0Xq*Lj@)@0OhoeUBq^7L_ctapDZn;9$}}GWI^225p+RnXG$`_n z$_WXaES>^*lwA=QXFnHp9h&fA!)hFIFY3m*gJ&}%YZ1xRvM#;7`F#B++Lr^yJ;c5c zxNqNr9v%8G(V!7Hd3F5g(Vl3p5^cW3>aHzaffT+OIL|0L^Hd%qp)A$2#W5hkWs*)$ zn*Hs6j64WKkoDBy#9>LEdE zpioiusfS+W)H~uiHw!L+3l=VCK?C~=ghaWsHRDJD@fes0 z?EMO$e?}5!Oc?uiIv;Ul1@>R6Nv_`lw^6=7AjDsw4oKwwe1fjBBU8b&jXAEIrt$+^ z=6tBo;Y1H96cjsR==%r}s0kp2+e&^Bgu6mPNuZ*NTwhjr(rW#c@1}Qt53%c04^_;9 z-OjT8e*AbHD6EM>j1qKVy6b-bRL@>X%qDO2TSm`6b;F1^r>$G{oFNOMJ!g_a+lDvl;@U# zG3G5;BiH&gRM7Vi1G^)A?<^usQu-&+FU&Ryyj3_507tJ04Qk|~A zeP3?3UYz(rOduD#%R9-GlR;%Pp-CW*G_yrA~qKAjC*R3Ve#PEjKPkvgr9=T>Ox1u4zyM*0XGY6INiF`tLmNc z=@>mE@s&#uQh*WOcstAL%ruCsjvziuU~$eA&%GB|1KknWyBf9JL-)*ny?Qm_adpwY zi4q{7SMSeXzAXKeH*%wQYFTNirlFx#aVw2)4*x&o-m-Wlbs#pY+`--JR$bPey41Ji z+%}@}^X4|OeWUAd08FW#eZeucCe9b}>o3ZU^V_wnsiK9eJz_o|)WbDTw$}Si<*06R z{pq8AN7rz!kbJ*E?}!DJs5HW?l-A~TIB9qUB|(9!Y?3Js1gowoTefYJ?39mGX-9CE zG0sFW6HHm%bsHka7ez%|h>Z#TLiClP9Dfvzb_AKoA;UgC_hFn|U=A%A#eyNO z5y9h}6$36@ar@FmSXzmyWsVMaO#(16+C)Uza7=&~V8u&uzq_}p=6SoQQ298KiMmc1 zJuuV?xyhyzs6T&KVqb|zxa#&ra!T11wfrq8CM6OxaKQ2|velrpICEaVc*?(bvP+jP zNlFeC6%|Q~Pt|zAwPF6zKf-j;F%`JpK$UpjM2$3|t>Csd=t-!bO)@25awOg)k!m_{ zK1gh?RGq*twG@)rCtG-r9%lBHIEo~|2VvdYtB2iQtBHAv!4ASJa#=1k9+!C>`6vEg zBN;Lzr#Scmnas@rvXq~C0HK@iZ`q=S(2*1z)HZdi+T!hlKKp#u5*KDDM2bO|2+piF zob$VX?5w^*>!ytPmL0ref`q>VbYMchm|9k+PMr`w1^`OG1@Wvw35B7f)HO`0i^Nw2 zd(%ctJ2@pGDpkv@M(-E>(xw_APMUe5{sqtwl7>$V+WO059J)Tq%%qum{_i(;TQ#rL z_Fe9>dDZB`+hI5V3umZ2Ir}-;`6e7*MT2wr5N!r^voNQ)g*!MqESo;@1(87g47b-! zfWCi7D@9GvW9HSYx8Gok1;kGM^%`eqLc&P<&wZ=XlNGuoWBb9PpfB{MAL3!?L)kHzDG?L&- z-v`-rQQ}2lkk`TF2~|hY)ZB{b8yEKOZN-k@)FXb?Cr!^Sx96HKb9KE9A?1;hv<%W1 zZvXy^*sLb|cp&MTLy)OT^e-s%q~aR0I3d)X7x_~7$pirt1ic5pS36|G7XQ!>?Ag8h zO=!HA=rn``0pldy`VM&ozyr2}}&u^cc?<&vq1@nU5i`Ev`2nJV6`doDL zD#yS}h)MV}#dSI>`7}Pe>7kcUc}dp5>C?)db9=Yz z(4h(VjK~TA7n0gd=EZ&Lp@F-w#|XErW=-~UG0SOgKuqB0+_?Rqdfbga`5&o<7X}fe zCW?iqHE;*=j3erqWM#F5n1yx}pT_9d;*J~KfkDQ7yG0Z{*h$4U8?StF+^ks|#!4(o zF{>LZX>MRCt6ylZz!lq3^X%EPCwEqWExdU7^2ng?PFQpBnnrXbI*8uI}DXOh_NJaxYXH5lit?d9uHBYXJ`wSq& zMP1J+7)l?L72^_~m{Ul_d!0j?4X2(W7_=eDkOH5YCy%qIzuV`(>NIKZOB@nae$<1T ze$hml`~yAO0FseMqXS!=mbUhzdhH2I3n-l?Y6&5KWpoBtRYQ}ZN+#C=bOsM@2Rp@c zT$dX0A=|h6*w{E}b{uo#24kT+%akrk8fnC`9QS zdv+ZBzKW_}@EtV6zj876vGXcCDSJiqQUAjFEgf%~H^LkU10uFsFxe=uCx?Tye)K|; zREV=Bj|$NQHcy_HUcDmS!%xr(H2pom(6FWg-^j73aU_0Z3_M?zvxNFy0w$0FdS1EW zb}it&D5LN%zr+|Q^GIkKCw+Kkq$NpMNRP!tDv=Q4U3VEs*eRUXn-ZP2RXgq^oe#g1 z<^+s57G7b#_G-Z9&2v@5jK0SdEe;B=yHEVEI54}gq|wKRkYJK@&^b8o!&mME=@?Bs zJStZ&n`f21_)K^v$j2!YPn%OGPu7FR2cNhN;8T2NhC)J;g|nu$VWa`IZEE2B*wS_{ zK7an~em{327I}da8Bj2}xG!q9zy1Bwa;KAS#aGDFob$6{SORCGqtgvL?(N8NDt2l1 zI|s{e_3wCYiM=5$Cw^ENts=%0%QsvEP#z^ErC>B^vKK%J&05j>%(QTx3#$|E3Qv)_ z5ai;L!`3em{M2do7!9nv^+4h}cIp&5-htJBeR;}YZ>obA7?n~TJMhGVmv)atTRCS% zsjJifP&DPvFsyp}n(seY_I6&dU<(byOZ5IX=?vw}6`w7wO+QDEKfY0MqoY}*9X<;* z=I1Oy>Y{THSF@iV?bGhWvrBjgsQQKlJq!l~lUQmDR=#0d!BluLGRU?9h=qQyEyH0J z930f0ePQgL9yh3V#GY%9{CyQUqE64AG;Y{%BXI$|m~WCRxSqsda5*;O#9ByjO6Xdd zcp`nPfk6wvOoO?pahYNernI$3`7Nmo)2Fu<`3u{e(?SctC7wpQ;xCJJI#jPI=MROw zOE~{t5?AmKTO+K^R*dQ?Cu9GSkIIuHAqbQb_VB0b#s6(xb?!Ok`2SccUCJ@<(4n@1 zEhhnqpoF?}k3zHmUn-@OYw+8P8J_Ig+OqMmI6p!McPmDAx#iMx_lBH%AHRGVK@;j5 zvA-uHekMJ=aPs8nU**4%)znac(Ij@-K4=5T3K^z1Hl`xUhu@#v=^zKr4b<#z9jcMG z5B&nB#y2wkaf^*~w!MAmr?W?C1z)NQkXZEMlx0Oe9>TK#CmwiLS z$!VgCOFAD|nJEA^Hni5{jF$J5z(fpn8(ja3cNzHaU>KAC8shTTzmT=@|Hi-6>ocd5 zs)Qp76QJ;f^#ajF&hhX=<#`z!#%ZaLSz_#VCCmTtODBi4UNO%QLq+|gH3XQi-}KZ< z90d}sgGlvns@0s5yy~NT(qLV!Kwzc5j+V~o*&0>%jO5(a8sAwn#AzcHxUafFgI~XX ziKcIsgTp4)D{7>CjGtbppU%B!Z{3U$s+MAI${{~C7!eSNfm|xtygWPU>(KHKx3p9f z0D+x4AN8%0LZ%wfjwlook_0W`&6c;0^!(1-#kNZ7*n0BZNP4TS5PktJR-urvq%AGF z3wMAw(w=}MnFS*!COPd$Yh^|V$uSH*+O%sC@)-H7?6Z}_Ub2cngxb@HIQ zy87{-hBD{~Zn`D~8G~9nNIqcI%tf{tt87;OF{vH_i#Br>zvMN6syC6|#-=OPUkEF? zPTZ#I6aTAgT3IL~y;iX&)>44xkkH}BwF;#yWM>?K_B*3|NZGqSC>7`TuqLETq-q5& zWCq|13-99*V0!FQQ}g>2#XM3q6~BeCGV&Ng52EjN3}C4ZErcY-R=Hp$c7FHgr`g$} z>y#-tG(yt+h*`ALVUF6_kf0nnqsEM>FR^q0*f%(hJN=Bf&)!FXeglOk7aYsjj(~to z0OoW}eg4?b-8~B%9dFXk@aXRjDk=&z_M%D|nlP~hTL}Bf)yj%80*{7|AKw@`6~F{i zHo+D6U1u4F<(F%3F>hh-_w=Hb_ylCqhcGYnzy}7oH3jzFKt|z^%HPY;fxeVnwcghj zq-%3ghOwwv88YBNlxIMYT3HM=m-HGV5}sc94M?eJt+05 z9gv2?Q(l#gY07sTq`s4%<2Vp8E&FzrsIT4f>VwGr<6Gt9Teoc4Jv&<;#&vu7?f5Nga3as(=Ei*)yr ztF&DbZUi!e&)S5uE@au?s|#$L5X(wPqN!Ctv5e{C(E?W0E{2GCh)9%n%THqf&Wqq> z1U#rH{>ZolOF+8EN>6=y=+9Dn0ix5vXkA;70fqL4hrDHld;&V*iSYIGcA=mJ2H%}Y zX-_N;8xeOz{{*k7=0o0=oahr6 zVQBA~?ipFy_vwbhq7eb%bwbR&T{2g8y`(qvjPi>0TNo&JInwXqJlkUT_7@T8evW-Z z4>OCC*Dx(|j@{?n%@6(BZD~C9cTbt`DYG-^N0va#O7)N1P@*^f(9I!rr=QuLsI8?% zWX^`?N_>QQ4n2{?2J>1|KninEA33A%2Cs7A-A%Wj-hZNQw|!uX;K38o&$B!wMuM$Y z(jupHNUwfULslDi4wy2nvJs6xIdP5Hs}(~jn2;uJK}=Yctcu37EIzz{_2Xge67pj} z+P6Yl89DLLy9xk_p48#aO3;ti|59>B|KzHhttRW7d&=q>%7!ML4=ntkPq&&8$djFG z+5FFYFf6n7cKeezR^H~ZVU0h0o$7p|*s9n3|4J#x|Bbq&&|~K0$xRJiKPW?P;@xR| zt@6gkV`neii>uqY6TKu)0NNadf^D!)*RChZY?Mn|6%tznLv2x9TFudw`*n_q7j(Bg zt#{z@vJaB)hX(9}bp?*F`sgG@R)KQvdt5;N%>Df$RdQkq_@x@Xd#kWo^&PVT;&eUJ zXMQ5 zi=|=&p9zcpEwBcyJZqc)rfr1(%(TqJ`Xu@1JnulRVFs(Z>(oAOc4gz-`-^ToHEgrp z=#Y0-mY$z;Mud)6c(G3Zfw}*Lj2x+6jDbbvjP;xAkM!E;SiO4jC8eR$tJJH%bk_W^ zQ9a}_q(er=6Us$v!kO>AD94xYwS7WD-{;QT0t8za^k6Ty7M2kdzWk5AV9l~ zwmAtwzZRMCTVE<+ib zH*c=>E0K{r%x4AX6loH(=}s-byZ{@L)JX-=6eOaPxq66X6jqqQ_a|{{2eOor@l5Pg z$z2yojxexXY0*K57G-g)qBP}5kz|)}HzaT}C&oqnjU$O}a-&(WA)ve>h5?S3zN%^} z8fee5IBubonm^;27Y-dJq!M-M4N%M7UoRY74At{+-!x~pT0;S-fwt;mglyY?$u!2qW0d`L?Kl<)hm^9Z2{z|pBxTGRD_s``0%QawTOCr_WQrK$PfTY`78W2>sV z0YDWT@ovA1O&TB67W5}0$O9f}T$Rm2IqEkE$RL5-1D=^qz@bgm)X<>zl({3Ss&|u< znd*Wi0?2^H3Obg720d(Ireb|`0E|rP3kT7(efx;>jk-*T)49KY z9$_a@2L@Vn!QA{8dAD1A?yRrX+0Jg+l+tg>{#jX*e|=6KXt!wHl!zJKGP6A1Jg^%x zPRHLS*7WG4(1i|_ruX+bAd0>;=l(v;yZ2iRSaW&mgM;1sI947UxHaLQyyHD)&d_@E zAOI_M!slOaT=gGS=4~DL`IY|_tK!USt0Rp|BeAI>A}VgAbUZ;BM`FAF)>#Fu9B&0xavT%itm z)3jBqu55jJtXi2Ng%Vu#RQZ~;J$oXq64oGQbrN4l#~W*Dc|ZU5Lp}5MO~|P|hu>hz zfVn)%+8|^BaJe#=NML?K8%nIcJR#>)F6-G@>m`y$O!K6^9`t!zVx*ldQf}UuxW6%7 zh%C5H^lkqML%K2aZIh1=8YmxRyMNN9=fIK6h$z4OAB2oGqhPT_4v#XmDo^9VgYm$w zMbEl;y<&A4KUMoSUrk+IoBhF`2#dQ&1WL?<-qv7a`U}Or#mxBcPn~2^ld5VrEiDxm z`xrB`$5|)%4Cjbrl@(6D0!>E7zKa)Uxx+!(IXH9{1>ZT*zKh`d>eU%nd~8@Q50*_h z(0@{U=DPYh{ArMTfTj5>O02DWuYEQ8R94or-2=_--uU>~efk_@e&VxO zi=q9{@s21irE{c*>ej1Q=Jc6^1M39u{LspFO~;f$UwnOh77_v^a|%BlO9DA?sZ$$Z zwI!RHs;Xu5f&h$o7Btgys75DGo7M$n`5aiW-|w_Xk9L=f0qvE{Zxq9Ny#*m371ks9!Go4`<4R}KUEV)6Co(e9b8KM&%$|oGuPO}_h)3jOg#EFXO zmJZ!VTrc~6f0R2=^{tF)abZt?d#rYC-^%<-WsTp)SzIb_N>pi(df)8&^mW-~ll#~=?QjhvSr_qrji(aMg?U9)S=9~mlnayQx zZM1F>r`a}SH+?Tzgr|!>i-6ubRFP376t0d7PZY0lnvmP1sXqrMvggh{8JQ)hP}9xE zZAWlas!R&c58SykwP>|}TuBG?h!)7Oj7Ma>T~Q=c4v4ZMBmoXAh1Q=b;Muw8CqVj{yN1gmF$Q#+CMBE*}*Ktv&9mo1gOg zvSD@$+D|YyZ$b5L<=atp@MEQ@Gx?8pd~#g3#=w?tSCq(B@3Ofn3C>UZbcrc-@YPKW zT#66)~KbibM%t8 z4?CW5DWfLi<`d>S-02ER+{X*h&X=45>09>GVHcsNqRwMB^88v^Evdl^}8}-8`$lqRZh+`RvaAhUU)RDhhpLt z$w@_diASx6Ln=6FZ!^3M+q?o2?Qwc~p+S9fr$`5$+s4m^O?GvG!dcu|!>^uL2tKKyRsDP===0Fq|$C0Vp zQH1PytFh2e!AsEA$yml2#C&cC6S51t@vFp!tbx^D=Q_p{Wzs{=ygD&A^ z-_u{dvn+46d~MMvlYRMLQk*{B?HYY2W%2bCqi~!h`}R(YjcwDh(+IzCi#ENi7bmUv zYHZ+T*5$_6!u0;Dr)@fLpw6wtjM?d77vsk)y3Yqb%g_nR35nwN*}mOdqaHTmT8gh9 za@wHQ7c=z4Y11+yhFltBn~ z8xs7cuN8DLI(p=)RsHFoMQtS#8q{wHd%z#(FPF98buv8sCK4pkS5Z+xiyZ)si3?P4 zS=t~sxRabb0(;a?-y-CfM`B{sd6YQOQJi0S5V!A=x$FkHUXByYP|6FOjoZr?`d~!Q zz4;WV$YK^pKM*S|6ut(G9XRYy^d+KqtGVjqk0v&e3FVN?qL77~Q#JmZ4G)c=EUAV)Hi4ub>pB zaNEjjorJB*GrKnKYta4Jh=`>o??2?Un6qf6$xW|-v}0ra?04**I$`cy2ledO*xX~6 zFIz1oNm#uob;K~NiH?cB+NHOR!W=VBYx@}vcGr5lfANJ0%Z^Vdw~1X)cp|Nyiz|VAzk*`=A3WI3(#q;l z!(La1!gfD)l2uk378!Yh25ky;-`&TLchjU6!WTD74i68X4>LW-*?F8ot9$pYcnant z#CXh5jH0v?O(>sIZ7V*vTDt6X#)C_*otbrW>B*&zD-w>r|E96vfC1=-S=%=pA5(Z6 z``2=+Y&|;pRR0e@QXW3fDD%F!^a|3s8XB91ANdk}*`uajNMd|6#L=s_Z$~2qmL%$y z&DLWxeF#J=?@MkkCGHBklDg{6Y|6X*^_Plb>B=RtnHeISJ_kMrH-l(pmjz>>F`{H?i<9t`FC9PZa%zFF$qbj+Q-jLD=FJz9d zq{*{^uYERKe$+S0sAI+4eY)RIs1k=lACIs?iC~rC(9kko&gG(me3x!wd!?>vRWByz z+InU82m122RsX7g(Aj$%_l6!Y z>+|pbsgpNn-=E*vx{u2L`Fj87OMHzTd;I+Q^Dm2w8^Y9qfnC(f1)PN>{L)&pxV3?S z!K#;=S^>q?9;O2GF?*sLTlrs2?}jQ{_Oef$YM0ifAiwcOmmLTl&_@nEHo4H|4P5#L zfB$Am!>)thcd%RGb;Y%$J;qKY=K08s)10};l&PkRJ8e7Nnc%-Q+=cA}l^aP+3apW` zVauuycStEdc8)v!&<@jMqF8>l%x&v38W5V%54y$~x@;n1I-yn8YTker?|Seuw#=(v zAC29v_sXb+lT+>S2Y%Xjt&KKtgN7K6nw+T`TPLAZWgGXSK9o&K%#6(&)TR_^@9tar z^xEovcP*-Yy;oOk?jMU%LR_g4al|8)7hKMNnMXuMNWA^ z3+iVO2{+NVRV;7sNG|yJ{ks>^8EB+gEb56@V1i_T%HX6OPYzGDu{oIWjZ(0``&TW@ z7^hsVmtASgLAzhny`->4yFIcDn~1CObN60b6~#d~=qpk20IofkBOx zm2ZWN-1-6~7|JZp%a@3$(z96XN`O9OOmwEr6ww6bi+n^YxVm0G6(`*{iB>H)L=jCgVRX26&)Yg49oqrP8 zB>Wf>&R~zqiYx*br(a~Yt9WXYfj3l?YVg$CUD2qwig-8tSiL@sO>=k_lO(v1%hNcW z15^#@fIId)aqQTQM~}{p=yj>Qpp}7%?@3Z4YUae|CKN|zI_}=Px7o~9M;c6<*5J;Z zfXi$5-#S;TZjq|W#2Vb-wrxM;73>Y4WPa?)y3wNzG&MiWE=W?(%FbnIc+JCWr-i$+ zaTY)M(o<>J`l1E6n@sC%sQLPJ1HaOxOI>!DCeNOKYUt3RwI3X|aN6zhX{1h_CK1;o zY+RPO=sz)r%p3w=n6+Cz%ME8)AB-fsr(I;4SrRTfz{8Mg<&Z z4tQ@80Te@_hieE7x?ZE6-6Lxo8$aSE#M}f-gCe&nrDo@gmq>vz+oxZjJ0>XSA&-h* zEu(7ry%7e6U!5UXUkJ$NEwoG84^}hTwFsz(Qu2}C1JUCj~=J* zU)%>CpHHCl-<$;WSHk8JS5s3F78b^WA=s=o4=<3ZCWs_L1iQ7G!#P7(a`e4E6lQiD z2r}ByGsAX7@F$l8D7%2fMP5hAb26taa>8lP5B9n!lzH+q+@n=wf6HpN_3PJreNuK% zATdHAps1+Gk%Odp)21O&_hGylNr|B@~CW=|O^AHI~DWGAr=Id*vphXd0BCB=il~t-r%>oSKf+)NyKR+J+u8M~>Yyb!$QBD2s`2 z9yEA*{sffS7%9HL+N-Id#RyVwG0M5jqG|(WN_Mv(67B1UO z$F>>W(<1Gz|2Oya%oeuIx`*o-uDcqSQ0m{c`0j)8!|K;}S@C|~K87+szH)v;Qj+>D z=OL9d#x!o+U|;VeyCQ5Y7#-8-YxxfstJ_WlPw11L>*oT(O7&sFTpt8}a*;_>9Nlwo z8fP+>Y&=}%07epNYimL_?nC(j`-)0U9l#lJ3#+HT;@Hunju(s=zxes%$6#>jM?igr zLGuoE3^MDoC%&{O{I8v(9RdB1PSrkj?%ZUjcMy{y=sX=yXS3@{sR7v2joM+RTS1F+ z(b30n0;;H{BEGsyuIjV6=+?k{<9MIwNxCJaq?~Yl?&b}AehM7TH}%%7ziIc!fBW{0 zHEIH7u!6X@Gf~9Q?J_;4kK&#C8w%7kiHBH!Te*ep+UWbsxA-_RYv*f4S;^L9==l>; zO7fv(-N96hrWD3=W@$M_aVIl#FX~+R_1K6^U`-E9uOtt*6G(R{KaLxAFZ!RmPoM51 zSn_?}+qd}vDMDZ?b{{%49`NTcAO)VB1(_Aa&B7z>qc+1|Nb=YHrE_FMU%jjKZZlZo zDIGu(AKA|zyk(y(Cm@%an0pU>HM^3&nh zq*^~h1~>{Sd4_A|*JZR~T*A)BCZCG_y|ioEI9>DtshCOULlIB4I59ZYX?wJj69mNP zY00?uf}foCDDyVzVlrlekxgpR_gL4=M^h%`q)+eXG_6IWwps2SoMox`XY49`@xs*V zQiO^9!N|n}-sf0%@99x-W!GQ3^kUY=9&!8D5|qz`*a^FTwD%^DQBm5JT)^~r|GRHd z@n@Vo&qPJ5v$JZbs!Bmft#<0j5eM6+O`|}1cNuGfQ#amRj6}|4gT_N@hs`HH{e~0D zeEPZ^zU|i0_{|6+uVKu}J7;yK3pD&wAUV~-y=I(B{*c}dbLKc+7z~?&*5h#NQ1Bd+ zU#QotZ>9aEtGg3|?bgvlK5wNOW)UwnYBcWncHS*TGqvWeWt)Z%+n_OV(xjb%!Rrtp z+Wq1oVSvX{kdOXwnt z2owH%zl~CQy&E&<;ovlq%=1c!dp{W&ISOrTqL3LnMeIJoVPOqu@2^gMg51>jZy2i) z!yVJ$jwIw?tWy}C+hvd%2p;y9ou%~q`>mpq_)VQ8&TXyYY zOi^(&TWdYN$J5Urud^Xo#e=;FFZM9|*qPUSA4Z1SYw>?zy0%LXPSs9- za(wcszk#6>V}L~bF8cZUO2%L6#h&z)AZ+LagA>=;URgHs86$X@hHWw!A17$OqjMi- z;*i9Yzw0YBv3iRZEz~dVY^}*VK}ob@^j~(qK+zhSe*J+=^zERv@|-*4gF<-JEE%y3 zfXOL~N?L}z5)_-rA>3b-FYZ3g=5}6r*~BTKZccTp&LIDL!E;J0MuqB^k2hA&cHFOj zdJKr~$xqo!KFvd};`R5#=3Gch!3|Bl73IK6-lp5V##mlg+f0|{ z#Ni&y7OM;{r1u}=!YeA%wzH33$SOf_vvi=d|K7n#Urw>`a9QZsEv#7g?QGt{ijILA z^_o0eWF1vx*m6JB^qKA5t2d>|YP-#NjJC$ln>%;7=FVXFI>X{CF)=bX7?99w)XA=h z5=eErci5_&|m3B+OLY;En!^l49H z&C~%$_H?X<4E1+a0uA2a!3A${ve?g(V!D}o@Rt*|@$1z6E4u}l&R_u4jEufR-lwXT zMHWw2QnxJu?eSZDzp9Trw4zSuG_qfXJs<@^<~f)h9@37j)38{rO`EFpDMXc3s31~G zl5jfoX8P>Py3d~hCITdRvCq5|PZoO@dxrJGR@fq8s-gq$PuolIl$tm(>18zbCd-6D zzvRAa*+ZW!DlRJGVJ*L2Hpd5&@C9VqFhq(F=(^R}Rjyh64n$tH^V(3;pk=Q(?|Wtj zJ#DAir)!t@{Iz05^I3~~z4-YlQO&E5-s8L;Ir|%gy;LZaD#sWPo7&FYHuvYV9KR(W zXSLJTt{45oKvix2w#r|Jt&B%yYW9k(abiL^`CEgJ9*Z`5LT-A0nHEbL4gk=CH6M{3 z{RU!egV+Q(mt7*nohK|tdAfPKryLZbq=bt3&qRCI#l{{UKUv|HG;d2=O{ zd9)_z?rRy9e{Dt;dX`Y?YrS?Z?nwTZ6kv}6)F_^aY0QQHA*0X^-;v-ss&P^tZaJx4b%KY zmyPdFB6$c{`4&+ozF7bpyzBxI{$0HkiS`~xA({DC+T zBoP!Vq#P+a?Hid-np6Xfj0mv8oPG~i1^tj&r$~HeQypNAxg{*%9;Vo~WsPs*%mr)G z#hbYCX{H0hdOADMSbbbXmn%8AO+al$Um?L;zmG40>AaJYG71dM`)ls8t)8KyoOkRz z;uX2LcH;KT%EKO;m3+3I$NXdPHods#>-(|Z$HuzYE?PL6XFB^_LR0*xH*XyIlxjWB z#COMw@W|626Iw;L?tivzpLx?>J|8?hGvd8R^H_~~fkW0BBCOPJZ(TU_l%LEm z#Rv?MF>lE;kMd&MNw&7zxdNMuD=L1(=Zi%E|AxE-r(Pbk{=!c`PnSivv^O?Z0^VtK zYU&oO1YkZ#bM`i&!pO(ReH#`;QuL~W44NUwpKq~xoO64`J+ffL*H&!V^OaH^jOtz8D--i9L&5Ww2pcj=--$O?y!G+Fg(NbH3>Ql>DV{m+o zGN6DQ6APc5^KO?mq6LotJD}gZ$$b*_SxSx2j;N{`O0H)&JQ={@v9d@w6V1xRIuXFH+i4_x-h8 zbrfm=#7(33rS!PHLc3eHVMtLWCy$^rG5JzABdT$Kc0}zo;$ir*7sgfK)ajtEMe%bu zwEV{W6S&UjT?f~C?^IctBc@J$4Di!#U+ys3%R$NkxCH8bsiWtvqe z*zrxz_qzQD_BuVOY@UVPzYyA?iT~G#*scF-(5 - Learn how to write bindings that allow arrow to mirror the behavior - of native R functions within dplyr pipelines -output: rmarkdown::html_vignette ---- - -```{r, include=FALSE} -library(arrow, warn.conflicts = FALSE) -library(dplyr, warn.conflicts = FALSE) -``` - -When writing bindings between C++ compute functions and R functions, the aim is -to expose the C++ functionality via the same interface as existing R functions. The syntax and -functionality should match that of the existing R functions -(though there are some exceptions) so that users are able to use existing tidyverse -or base R syntax, whilst taking advantage of the speed and functionality of the -underlying arrow package. - -One of main ways in which users interact with arrow is via -[dplyr](https://dplyr.tidyverse.org/) syntax called on Arrow objects. For -example, when a user calls `dplyr::mutate()` on an Arrow Tabular, -Dataset, or arrow data query object, the Arrow implementation of `mutate()` is -used and under the hood, translates the dplyr code into Arrow C++ code. - -When using `dplyr::mutate()` or `dplyr::filter()`, you may want to use functions -from other packages. The example below uses `stringr::str_detect()`. - -```{r} -library(dplyr) -library(stringr) -starwars %>% - filter(str_detect(name, "Darth")) -``` -This functionality has also been implemented in Arrow, e.g.: - -```{r} -library(arrow) -arrow_table(starwars) %>% - filter(str_detect(name, "Darth")) %>% - collect() -``` - -This is possible as a **binding** has been created between the call to the -stringr function `str_detect()` and the Arrow C++ code, here as a direct mapping -to `match_substring_regex`. You can see this for yourself by inspecting the -arrow data query object without retrieving the results via `collect()`. - - -```{r} -arrow_table(starwars) %>% - filter(str_detect(name, "Darth")) -``` - -In the following sections, we'll walk through how to create a binding between an -R function and an Arrow C++ function. - -# Walkthrough - -Imagine you are writing the bindings for the C++ function -[`starts_with()`](https://arrow.apache.org/docs/cpp/compute.html#containment-tests) -and want to bind it to the (base) R function `startsWith()`. - -First, take a look at the docs for both of those functions. - -## Examining the R function - -Here are the docs for R's `startsWith()` (also available at https://stat.ethz.ch/R-manual/R-devel/library/base/html/startsWith.html) - -```{r, echo=FALSE, out.width="50%"} -knitr::include_graphics("./startswithdocs.png") -``` - -It takes 2 parameters; `x` - the input, and `prefix` - the characters to check -if `x` starts with. - -## Examining the C++ function - -Now, go to -[the compute function documentation](https://arrow.apache.org/docs/cpp/compute.html#containment-tests) -and look for the Arrow C++ library's `starts_with()` function: - -```{r, echo=FALSE, out.width="100%"} -knitr::include_graphics("./starts_with_docs.png") -``` - -The docs show that `starts_with()` is a unary function, which means that it takes a -single data input. The data input must be a string-like class, and the returned -value is boolean, both of which match up to R's `startsWith()`. - -There is an options class associated with `starts_with()` - called [`MatchSubstringOptions`](https://arrow.apache.org/docs/cpp/api/compute.html#_CPPv4N5arrow7compute21MatchSubstringOptionsE) -- so let's take a look at that. - -```{r, echo=FALSE, out.width="100%"} -knitr::include_graphics("./matchsubstringoptions.png") -``` - -Options classes allow the user to control the behaviour of the function. In -this case, there are two possible options which can be supplied - `pattern` and -`ignore_case`, which are described in the docs shown above. - -## Comparing the R and C++ functions - -What conclusions can be drawn from what you've seen so far? - -Base R's `startsWith()` and Arrow's `starts_with()` operate on equivalent data -types, return equivalent data types, and as there are no options implemented in -R that Arrow doesn't have, this should be fairly simple to map without a great -deal of extra work. - -As `starts_with()` has an options class associated with it, we'll need to make -sure that it's linked up with this in the R code. - -In case you're wondering about the difference between arguments in R and options -in Arrow, in R, arguments to functions can include the actual data to be -analysed as well as options governing how the function works, whereas in the -C++ compute functions, the arguments are the data to be analysed and the -options are for specifying how exactly the function works. - -So let's get started. - -## Step 1 - add unit tests - -We recommend a test-driven-development approach - write failing tests first, -then check that they fail, and then write the code needed to make them pass. -Thinking up-front about the behavior which needs testing can make it easier to -reason about the code which needs writing later. - -Look up the R function that you want to bind the compute kernel to, and write a -set of unit tests that use a dplyr pipeline and `compare_dplyr_binding()` (and -perhaps even `compare_dplyr_error()` if necessary. These functions compare the -output of the original function with the dplyr bindings and make sure they match. -We recommend looking at the [documentation next to the source code for these -functions](https://github.com/apache/arrow/blob/main/r/tests/testthat/helper-expectation.R) -to get a better understanding of how they work. - -You should make sure you're testing all parameters of the R function in your -tests. - -Below is a possible example test for `startsWith()`. - -```{r, eval = FALSE} -test_that("startsWith behaves identically in dplyr and Arrow", { - df <- tibble(x = c("Foo", "bar", "baz", "qux")) - compare_dplyr_binding( - .input %>% - filter(startsWith(x, "b")) %>% - collect(), - df - ) -}) -``` - -## Step 2 - Hook up the compute function with options class if necessary - -If the C++ compute function can have options specified, make sure that the -function is linked with its options class in `make_compute_options()` in the -file `arrow/r/src/compute.cpp`. You can find out if a compute function requires -options by looking in the docs here: https://arrow.apache.org/docs/cpp/compute.html - -In the case of `starts_with()`, it looks something like this: - -```cpp - if (func_name == "starts_with") { - using Options = arrow::compute::MatchSubstringOptions; - bool ignore_case = false; - if (!Rf_isNull(options["ignore_case"])) { - ignore_case = cpp11::as_cpp(options["ignore_case"]); - } - return std::make_shared(cpp11::as_cpp(options["pattern"]), - ignore_case); - } -``` - -You can usually copy and paste from a similar existing example. In this case, -as the option `ignore_case` doesn't map to any parameters of `startsWith()`, we -give it a default value of `false` but if it's been set, use the set value -instead. As the `pattern` argument maps directly to `prefix` in `startsWith()` -we can pass it straight through. - -## Step 3 - Map the R function to the C++ kernel - -The next task is writing the code which binds the R function to the C++ kernel. - -### Step 3a - See if direct mapping is appropriate -Compare the C++ function and R function. If they are simple functions with no -options, it might be possible to directly map between the C++ and R in -`unary_function_map`, in the case of compute functions that operate on single -columns of data, or `binary_function_map` for those which operate on 2 columns -of data. - -As `startsWith()` requires options, direct mapping is not appropriate. - -### Step 3b - If direct mapping not possible, try a modified implementation -If the function cannot be mapped directly, some extra work may be needed to -ensure that calling the arrow version of the function results in the same result -as calling the R version of the function. In this case, the function will need -adding to the `.cache$functions` function registry. Here is how this might look for -`startsWith()`: - -```{r, eval = FALSE} -register_binding("base::startsWith", function(x, prefix) { - Expression$create( - "starts_with", - x, - options = list(pattern = prefix) - ) -}) -``` - -In the source files, all the `register_binding()` calls are wrapped in functions -that are called on package load. These are separated into files based on -subject matter (e.g., `R/dplyr-funcs-math.R`, `R/dplyr-funcs-string.R`): find the -closest analog to the function whose binding is being defined and define the -new binding in a similar location. For example, the binding for `startsWith()` -is registered in `dplyr-funcs-string.R` next to the binding for `endsWith()`. - -Note: we use the namespace-qualified name (i.e. `"base::startsWith"`) for a -binding. This will register the same binding both as `startsWith()` and as -`base::startsWith()`, which will allow us to use the `pkg::` prefix in a call. - -```{r} -arrow_table(starwars) %>% - filter(stringr::str_detect(name, "Darth")) -``` - -Hint: you can use `call_function()` to call a compute function directly from R. -This might be useful if you want to experiment with a compute function while -you're writing bindings for it, e.g. - -```{r} -call_function( - "starts_with", - Array$create(c("Apache", "Arrow", "R", "package")), - options = list(pattern = "A") -) -``` - -## Step 4 - Run (and potentially add to) your tests. - -In the process of implementing the function, you will need at least one test -to make sure that your binding works and that future changes to the Arrow R -package don't break it! Bindings are tested in files that correspond to -the file in which they were defined (e.g., `startsWith()` is tested in -`tests/testthat/test-dplyr-funcs-string.R`) next to the tests for `endsWith()`. - -You may end up implementing more tests, for example if you discover unusual -edge cases. This is fine - add them to the ones you wrote originally, -and run them all. If they pass, you're done and you can submit a PR. -If you've modified the C++ code in the -R package (for example, when hooking up a binding to its options class), you -should make sure to run `arrow/r/lint.sh` to lint the code.