From 8f1d171676789576a97d8b090ec306d1753e07dc Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Wed, 9 Aug 2023 19:03:21 -0500 Subject: [PATCH 01/12] - let students know about warning --- inst/tutorials/16-dimensionality-reduction/tutorial.Rmd | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd index 592d77b..f9fc73b 100644 --- a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd +++ b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd @@ -2797,7 +2797,7 @@ Often a data practitioner needs to consider a large number of possible modeling ### Exercise 27 -Copy the previous code and pipe the entire `workflow_set()` function to `workflow_map()`. Inside `workflow_map()`, set `verbose` to `TRUE`, `seed` to `1603`, and `resamples` to `bean_val`. +Copy the previous code and pipe the entire `workflow_set()` function to `workflow_map()`. Inside `workflow_map()`, set `verbose` to `TRUE`, `seed` to `1603`, and `resamples` to `bean_val`. (Note: This will produce a series of warnings). ```{r modeling-27, exercise = TRUE} @@ -2835,11 +2835,14 @@ workflow_set( ### +As you can see, this code produces a series of warnings. This is because for a series of observations, a probability of 0 is occurring, which can be due to errors in model creation and fitting. For now, let's ignore this error and move on. + + The `workflow_map()` function applies grid search to optimize the model/preprocessing parameters (if any) across 10 parameter combinations. ### Exercise 28 -Copy the previous code. Inside `workflow_map()`, set `grid` to `10`, `metrics` to `metric_set(roc_auc)`, and `control` to `ctrl`. +Copy the previous code. Inside `workflow_map()`, set `grid` to `10`, `metrics` to `metric_set(roc_auc)`, and `control` to `ctrl`. (Note: This will produce the same series of warnings). ```{r modeling-28, exercise = TRUE} @@ -2887,7 +2890,7 @@ The multiclass area under the ROC curve is estimated on the validation set. ### Exercise 29 -Copy the previous code and assign the entire code to a new variable named `bean_res`. +Copy the previous code and assign the entire code to a new variable named `bean_res` (Ignore the warnings). ```{r modeling-29, exercise = TRUE} From 7eef7d62c085cbfdf3f205fd655bd6a7c80bbbf3 Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Wed, 9 Aug 2023 19:20:33 -0500 Subject: [PATCH 02/12] - fixed errors --- .../16-dimensionality-reduction/tutorial.Rmd | 53 +++++++++++++------ 1 file changed, 37 insertions(+), 16 deletions(-) diff --git a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd index f9fc73b..897c719 100644 --- a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd +++ b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd @@ -123,11 +123,11 @@ bean_rec1 <- step_normalize(all_numeric_predictors()) pls_rec <- - bean_rec |> + bean_rec1 |> step_pls(all_numeric_predictors(), outcome = "class", num_comp = tune()) umap_rec <- - bean_rec |> + bean_rec1 |> step_umap( all_numeric_predictors(), outcome = "class", @@ -155,9 +155,6 @@ bean_res <- control = ctrl ) -# AK: Getting a lot of warnings/weird output when running "bean_res" - - rankings <- rank_results(bean_res, select_best = TRUE) |> mutate(method = map_chr(wflow_id, ~ str_split(.x, "_", simplify = TRUE)[1])) @@ -234,6 +231,30 @@ This is an excerpt from Koklu's and ÖZKAN's manuscript: ### Exercise 3 +Load the **xgboost**, **klaR**, and **mda** libraries using `library()`. + +```{r a-picture-is-worth-a-3, exercise = TRUE} + +``` + +```{r a-picture-is-worth-a-3-hint, eval = FALSE} +library(...) +library(...) +library(...) +``` + +```{r, include = FALSE} +library(xgboost) +library(klaR) +library(mda) +``` + +### + +These libraries will be used later on in this tutorial. + +### Exercise 3 + The data created by Koklu and ÖZKAN will be used. Load the **beans** package using `library()`. ```{r a-picture-is-worth-a-3, exercise = TRUE} @@ -2572,12 +2593,12 @@ Now, lets create a PLS recipe, which builds off of `bean_rec1`. In the code chun ``` ```{r modeling-19-hint-1, eval = FALSE} -bean_rec |> +bean_rec1 |> step_pls(...(), outcome = "...", num_comp = ...()) ``` ```{r include = FALSE} -bean_rec |> +bean_rec1 |> step_pls(all_numeric_predictors(), outcome = "class", num_comp = tune()) ``` @@ -2597,13 +2618,13 @@ Copy the previous code and assign it to a new variable named `pls_rec`. ```{r modeling-20-hint-1, eval = FALSE} ... <- - bean_rec |> + bean_rec1 |> step_pls(all_numeric_predictors(), outcome = "class", num_comp = tune()) ``` ```{r include = FALSE} pls_rec <- - bean_rec |> + bean_rec1 |> step_pls(all_numeric_predictors(), outcome = "class", num_comp = tune()) ``` @@ -2613,7 +2634,7 @@ Dimensionality reduction can be a helpful method for exploratory data analysis a ### Exercise 21 -Now, let's create a UMAP recipe. In the code chunk below, pipe `bean_rec` to `step_umap()`. Inside this function, type in `all_numeric_predictors()` as the first argument. Then, set `outcome` to `"class"` as the second argument. +Now, let's create a UMAP recipe. In the code chunk below, pipe `bean_rec1` to `step_umap()`. Inside this function, type in `all_numeric_predictors()` as the first argument. Then, set `outcome` to `"class"` as the second argument. ```{r modeling-21, exercise = TRUE} @@ -2622,7 +2643,7 @@ Now, let's create a UMAP recipe. In the code chunk below, pipe `bean_rec` to `st ```{r modeling-21-hint-1, eval = FALSE} -bean_rec |> +bean_rec1 |> step_umap( ...(), outcome = "..." @@ -2630,7 +2651,7 @@ bean_rec |> ``` ```{r include = FALSE} -bean_rec |> +bean_rec1 |> step_umap( all_numeric_predictors(), outcome = "class" @@ -2652,7 +2673,7 @@ Copy the previous code. Inside `step_umap()`, set `num_comp`, `neighbors`, and ` ```{r modeling-22-hint-1, eval = FALSE} -bean_rec |> +bean_rec1 |> step_umap( all_numeric_predictors(), outcome = "class", @@ -2663,7 +2684,7 @@ bean_rec |> ``` ```{r include = FALSE} -bean_rec |> +bean_rec1 |> step_umap( all_numeric_predictors(), outcome = "class", @@ -2689,7 +2710,7 @@ Copy the previous code and assign it to a new variable named `umap_rec`. ```{r modeling-23-hint-1, eval = FALSE} ... <- - bean_rec |> + bean_rec1 |> step_umap( all_numeric_predictors(), outcome = "class", @@ -2701,7 +2722,7 @@ Copy the previous code and assign it to a new variable named `umap_rec`. ```{r include = FALSE} umap_rec <- - bean_rec |> + bean_rec1 |> step_umap( all_numeric_predictors(), outcome = "class", From 4dadbd5b4ca7e0d728eafd0a4af1edaff96ef72c Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Wed, 9 Aug 2023 20:27:23 -0500 Subject: [PATCH 03/12] - fixed comments --- .../tutorial.Rmd | 265 +++++++++--------- 1 file changed, 137 insertions(+), 128 deletions(-) diff --git a/inst/tutorials/12-model-tuning-and-the-dangers-of-overfitting/tutorial.Rmd b/inst/tutorials/12-model-tuning-and-the-dangers-of-overfitting/tutorial.Rmd index 7ea3508..fd9358c 100644 --- a/inst/tutorials/12-model-tuning-and-the-dangers-of-overfitting/tutorial.Rmd +++ b/inst/tutorials/12-model-tuning-and-the-dangers-of-overfitting/tutorial.Rmd @@ -57,19 +57,17 @@ lloss <- function(...) { select(id, id2, .metric, .estimate) } -resampled_res <- - bind_rows( +resampled_res <- bind_rows( lloss() |> mutate(model = "logistic"), lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") ) |> mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) |> summarize( - .groups = "drop", + .by = c("model", ".metric"), mean = mean(.estimate, na.rm = TRUE), std_err = sd(.estimate, na.rm = TRUE) / sqrt(n()) -) + ) logLikelihoodPlot <- resampled_res |> @@ -132,7 +130,7 @@ updated_param <- ```{r info-section, child = system.file("child_documents/info_section.Rmd", package = "tutorial.helpers")} ``` - + ## Introduction ### @@ -946,15 +944,75 @@ The purpose of this function is to return the individual resampled performance e ### Exercise 29 -Now, lets bind some rows. Type in `bind_rows()`. Set the first argument of this function to `lloss()`, which is piped to `mutate(model = "logistic")` (Note: view the hint if you are confused). +Let's use the `lloss()` function and see its functionality. In the code chunk below, type in `lloss()` and pipe it to `mutate()`. Inside this function, set `model` to `"logistic"`. ```{r what-do-we-optimize-29, exercise = TRUE} ``` +```{r what-do-we-optimize-29-hint-1, eval = FALSE} +...() |> mutate(model = "...") +``` + +```{r include = FALSE} +lloss() |> mutate(model = "logistic") +``` + +### + +As you can see, this code produces a tibble containing 200 rows of logistic models. Each row represents a Fold that is being conducted. Let's look at `Repeat01` and `Fold01`. First, the `roc_auc` metric is being used on the `Fold01`. Then, the `mn_log_loss` metric is being used on `Fold01`. Finally, the pattern is repeated for 10 folds that have an id of `Repeat01`. After the 10th fold has finished, the code moves on to the next id and the same process is repeated again. This process keeps happening until the last fold of the last repeat has been completed. + +### Exercise 30 + +In the code chunk below, type in `lloss()`. Inside this function, set `family` to `binomial(link = "probit")`. Then, pipe the entire code to `mutate(model = "probit")`. + +```{r what-do-we-optimize-30, exercise = TRUE} + +``` + +```{r what-do-we-optimize-30-hint-1, eval = FALSE} +lloss(... = binomial(link = "...")) |> mutate(model = "...") +``` + +```{r include = FALSE} +lloss(family = binomial(link = "probit")) |> mutate(model = "probit") +``` + +### + +Now, the code contains 200 rows of `probit` models. But, the same process follows; for each fold in `Repeat01`, the `roc_auc` and `mn_log_loss` metrics are used, producing an estimated value. Then, the code moves on to `Repeat02`, `Repeat03`, etc. + +### Exercise 31 + +In the code chunk below, type in `lloss()`. Inside this function, set `family` to `binomial(link = "cloglog")`. Then, pipe the entire code to `mutate(model = "c-log-log")`. + +```{r what-do-we-optimize-31, exercise = TRUE} + +``` + +```{r what-do-we-optimize-31-hint-1, eval = FALSE} +lloss(... = binomial(link = "...")) |> mutate(model = "...") +``` + +```{r include = FALSE} +lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") +``` + +### + +As you can see, the models are now `c-log-log` and the same process as described earlier occurs. + +### Exercise 32 + +Now, lets bind some rows. Type in `bind_rows()`. Set the first argument of this function to `lloss()`, which is piped to `mutate(model = "logistic")` (Note: view the hint if you are confused). + +```{r what-do-we-optimize-32, exercise = TRUE} + +``` + -```{r what-do-we-optimize-29-hint-1, eval = FALSE} +```{r what-do-we-optimize-32-hint-1, eval = FALSE} bind_rows( lloss() |> mutate(... = "...") ) @@ -970,17 +1028,17 @@ bind_rows( What this line of code is doing is it's calling `lloss()`, which has the individual resampled performance estimate and is creating a new column named `model`, which is set to `logistic`. This creation of the column was done by the `mutate()` function. -### Exercise 30 +### Exercise 33 Copy the previous code. Set the second argument of `bind_rows()` to `lloss(family = binomial(link = "probit"))`, which is piped to `mutate(model = "probit")` (Note: view the hint if you are confused). -```{r what-do-we-optimize-30, exercise = TRUE} +```{r what-do-we-optimize-33, exercise = TRUE} ``` -```{r what-do-we-optimize-30-hint-1, eval = FALSE} +```{r what-do-we-optimize-33-hint-1, eval = FALSE} bind_rows( lloss() |> mutate(model = "logistic"), lloss(... = binomial(link = "...")) |> mutate(model = "...") @@ -998,17 +1056,17 @@ bind_rows( This code has now binded the `probit` models to the tibble containing `logistic` models. -### Exercise 31 +### Exercise 34 Copy the previous code. Set the third argument of `bind_rows()` to `lloss(family = binomial(link = "cloglog"))`, which is piped to `mutate(model = "c-log-log")` (Note: view the hint if you are confused). -```{r what-do-we-optimize-31, exercise = TRUE} +```{r what-do-we-optimize-34, exercise = TRUE} ``` -```{r what-do-we-optimize-31-hint-1, eval = FALSE} +```{r what-do-we-optimize-34-hint-1, eval = FALSE} bind_rows( lloss() |> mutate(model = "logistic"), lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), @@ -1018,7 +1076,7 @@ bind_rows( - + ```{r include = FALSE} bind_rows( @@ -1030,19 +1088,19 @@ bind_rows( ### -This code binded the `cloglog` models to the tibble containing `probit` and `logistic` models. +This code binded the `cloglog` models to the tibble containing `probit` and `logistic` models. Now, there are a total of 600 rows in the tibble (200 for each type of model). -### Exercise 32 +### Exercise 35 Copy the previous code. Pipe the entire `bind_rows()` function to `mutate()`. -```{r what-do-we-optimize-32, exercise = TRUE} +```{r what-do-we-optimize-35, exercise = TRUE} ``` -```{r what-do-we-optimize-32-hint-1, eval = FALSE} +```{r what-do-we-optimize-35-hint-1, eval = FALSE} bind_rows( lloss() |> mutate(model = "logistic"), lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), @@ -1062,17 +1120,19 @@ bind_rows( ### -### Exercise 33 + + +### Exercise 36 Now, lets start converting `log-loss` to `log-likelihood`. Copy the previous code. Inside `mutate()`, set `.estimate` to `ifelse(.metric == "mn_log_loss", -.estimate, .estimate)`. -```{r what-do-we-optimize-33, exercise = TRUE} +```{r what-do-we-optimize-36, exercise = TRUE} ``` -```{r what-do-we-optimize-33-hint-1, eval = FALSE} +```{r what-do-we-optimize-36-hint-1, eval = FALSE} bind_rows( lloss() |> mutate(model = "logistic"), lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), @@ -1092,64 +1152,29 @@ bind_rows( ### -This code modifies the `.estimate` column: If `.metric` is equal to `mn_log_loss`, negate that value in `.estimate`. If not, then keep it unchanged. - -### Exercise 34 - -Copy the previous code and pipe it to `group_by()`. Inside this function, type in `model` and `.metric`. - -```{r what-do-we-optimize-34, exercise = TRUE} - -``` - - - - +This code modifies the `.estimate` column: If `.metric` is equal to `mn_log_loss`, the value in `.estimate` becomes negative. If not, then the value is kept unchanged. -```{r what-do-we-optimize-34-hint-1, eval = FALSE} -bind_rows( - lloss() |> mutate(model = "logistic"), - lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), - lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") -) |> - mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(..., ....) -``` + -```{r include = FALSE} -bind_rows( - lloss() |> mutate(model = "logistic"), - lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), - lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") -) |> - mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) -``` - -### - -In this scenario, the `group_by()` function is grouping the data based on the `model` and `.metric`. - -### Exercise 35 +### Exercise 37 -Copy the previous code and pipe it to `summarize()`. Inside of this function, set `.groups` to `"drop"`. +Copy the previous code and pipe it to `summarize()`. Inside of this function, set `.by` to `c("model", ".metric")`. -```{r what-do-we-optimize-35, exercise = TRUE} +```{r what-do-we-optimize-37, exercise = TRUE} ``` -```{r what-do-we-optimize-35-hint-1, eval = FALSE} +```{r what-do-we-optimize-37-hint-1, eval = FALSE} bind_rows( lloss() |> mutate(model = "logistic"), lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") ) |> mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) |> summarize( - .groups = "..." + .by = c("...", "...") ) ``` @@ -1160,50 +1185,35 @@ bind_rows( lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") ) |> mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) |> summarize( - .groups = "drop" + .by = c("model", ".metric") ) ``` ### - +As you can see, the `summarize()` function printed out a tibble, containing a summary of the binded row tibble. In this scenario, the `.by` argument inside `summarize()` groups the data by the `model` and metric (`roc_auc` & `mn_log_loss`). Because of this, the `model` and `.metric` are in the summarized tibble. - - - - - - - - - - - - - -### Exercise 36 +### Exercise 38 Copy the previous code. Inside `summarize()`, set `mean` to `mean(.estimate, na.rm = TRUE)`. -```{r what-do-we-optimize-36, exercise = TRUE} +```{r what-do-we-optimize-38, exercise = TRUE} ``` -```{r what-do-we-optimize-36-hint-1, eval = FALSE} +```{r what-do-we-optimize-38-hint-1, eval = FALSE} bind_rows( lloss() |> mutate(model = "logistic"), lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") ) |> mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) |> summarize( - .groups = "drop", - ... = mean(..., na.rm = TRUE) + .by = c("model", ".metric"), + mean = ...(.estimate, na.rm = ...) ) ``` @@ -1214,39 +1224,41 @@ bind_rows( lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") ) |> mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) |> summarize( - .groups = "drop", + .by = c("model", ".metric"), mean = mean(.estimate, na.rm = TRUE) ) ``` ### +As you can see, the code outputs a tibble with a new column called `mean`. This column represents the averages of the `.estimate` column for each metric of each model. + +### + The `na.rm = TRUE` argument is used to ignore any missing values and perform calculations on the non-missing values. -### Exercise 37 +### Exercise 39 Copy the previous code. Inside `summarize()`, set `std_err` to `sd(.estimate, na.rm = TRUE) / sqrt(n())` -```{r what-do-we-optimize-37, exercise = TRUE} +```{r what-do-we-optimize-39, exercise = TRUE} ``` -```{r what-do-we-optimize-37-hint-1, eval = FALSE} +```{r what-do-we-optimize-39-hint-1, eval = FALSE} bind_rows( lloss() |> mutate(model = "logistic"), lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") ) |> mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) |> summarize( - .groups = "drop", + .by = c("model", ".metric"), mean = mean(.estimate, na.rm = TRUE), - std_err = sd(.estimate, na.rm = TRUE) / sqrt(n()) + std_err = ...(.estimate, na.rm = ...) / sqrt(n()) ) ``` @@ -1257,9 +1269,8 @@ bind_rows( lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") ) |> mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) |> summarize( - .groups = "drop", + .by = c("model", ".metric"), mean = mean(.estimate, na.rm = TRUE), std_err = sd(.estimate, na.rm = TRUE) / sqrt(n()) ) @@ -1267,28 +1278,27 @@ bind_rows( ### -The `sd()` function is being used here to calculate the standard deviation of the values inside the `.estimate` column. To calculate the standard error, this function is being divided by the square root of `n()`. +The `sd()` function is being used to calculate the standard deviation of the values inside the `.estimate` column for each metric of each model. To calculate the standard error, this function is being divided by the square root of `n()`. -### Exercise 38 +### Exercise 40 Copy the previous code and assign it to a new variable named `resampled_res`. -```{r what-do-we-optimize-38, exercise = TRUE} +```{r what-do-we-optimize-40, exercise = TRUE} ``` -```{r what-do-we-optimize-38-hint-1, eval = FALSE} +```{r what-do-we-optimize-40-hint-1, eval = FALSE} ... <- bind_rows( lloss() |> mutate(model = "logistic"), lloss(family = binomial(link = "probit")) |> mutate(model = "probit"), lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") ) |> mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) |> summarize( - .groups = "drop", + .by = c("model", ".metric"), mean = mean(.estimate, na.rm = TRUE), std_err = sd(.estimate, na.rm = TRUE) / sqrt(n()) ) @@ -1301,9 +1311,8 @@ resampled_res <- bind_rows( lloss(family = binomial(link = "cloglog")) |> mutate(model = "c-log-log") ) |> mutate(.estimate = ifelse(.metric == "mn_log_loss", -.estimate, .estimate)) |> - group_by(model, .metric) |> summarize( - .groups = "drop", + .by = c("model", ".metric"), mean = mean(.estimate, na.rm = TRUE), std_err = sd(.estimate, na.rm = TRUE) / sqrt(n()) ) @@ -1313,17 +1322,17 @@ resampled_res <- bind_rows( This code has successfully resampled the results of the 10-fold-cross-validation. -### Exercise 39 +### Exercise 41 Now, lets plot this data on a graph. But first, a filtration must occur. In the code chunk below, pipe `resampled_res` to `filter()`. Inside this function, type in the expression `.metric == "mn_log_loss"`. -```{r what-do-we-optimize-39, exercise = TRUE} +```{r what-do-we-optimize-41, exercise = TRUE} ``` -```{r what-do-we-optimize-39-hint-1, eval = FALSE} +```{r what-do-we-optimize-41-hint-1, eval = FALSE} resampled_res |> ...(.metric == "...") ``` @@ -1337,17 +1346,17 @@ resampled_res |> This code is filtering the data, making sure that the only `mn_log_loss` data is present. -### Exercise 40 +### Exercise 42 Copy the previous code and pipe it to `ggplot()`. Inside this function, using `aes()`, set the argument `x` to `mean` and `y` to `model`. -```{r what-do-we-optimize-40, exercise = TRUE} +```{r what-do-we-optimize-42, exercise = TRUE} ``` -```{r what-do-we-optimize-40-hint-1, eval = FALSE} +```{r what-do-we-optimize-42-hint-1, eval = FALSE} resampled_res |> filter(.metric == "mn_log_loss") |> ggplot(aes(x = ..., y = ...)) @@ -1363,17 +1372,17 @@ resampled_res |> If you are unfamiliar with the term "model tuning", model tuning refers to the process of adjusting the hyperparameters of a model in order to optimize its performance. -### Exercise 41 +### Exercise 43 Copy the previous code and add `geom_point()`. -```{r what-do-we-optimize-41, exercise = TRUE} +```{r what-do-we-optimize-43, exercise = TRUE} ``` -```{r what-do-we-optimize-41-hint-1, eval = FALSE} +```{r what-do-we-optimize-43-hint-1, eval = FALSE} resampled_res |> filter(.metric == "mn_log_loss") |> ggplot(aes(x = mean, y = model)) + @@ -1389,19 +1398,19 @@ resampled_res |> ### -As you can see, this produces three points on the graph. Using these points, the 90& confidence intervals can be created using `geom_errorbar()`. +As you can see, this produces three points on the graph. Using these points, the 90% confidence intervals can be created using `geom_errorbar()`. -### Exercise 42 +### Exercise 44 Copy the previous code and add `geom_errorbar()`. Inside this function, using `aes()`, set `xmin` to `mean - 1.64 * std_err` (Note: This will throw an error). -```{r what-do-we-optimize-42, exercise = TRUE} +```{r what-do-we-optimize-44, exercise = TRUE} ``` -```{r what-do-we-optimize-42-hint-1, eval = FALSE} +```{r what-do-we-optimize-44-hint-1, eval = FALSE} resampled_res |> filter(.metric == "mn_log_loss") |> ggplot(aes(x = mean, y = model)) + @@ -1421,17 +1430,17 @@ resampled_res |> This code throws an error because the `xmax` hasn't been defined yet. -### Exercise 43 +### Exercise 45 Copy the previous code. Inside the `aes()` function inside of `geom_errorbar()`, set `xmax` to `mean + 1.64 * std_err`. -```{r what-do-we-optimize-43, exercise = TRUE} +```{r what-do-we-optimize-45, exercise = TRUE} ``` -```{r what-do-we-optimize-43-hint-1, eval = FALSE} +```{r what-do-we-optimize-45-hint-1, eval = FALSE} resampled_res |> filter(.metric == "mn_log_loss") |> ggplot(aes(x = mean, y = model)) + @@ -1451,17 +1460,17 @@ resampled_res |> As you can see, each point now has a line on the right and left side, which represents the confidence intervals. -### Exercise 44 +### Exercise 46 Copy the previous code. Inside the `aes()` function inside of `geom_errorbar()`, set the `width` to `0.1`. -```{r what-do-we-optimize-44, exercise = TRUE} +```{r what-do-we-optimize-46, exercise = TRUE} ``` -```{r what-do-we-optimize-44-hint-1, eval = FALSE} +```{r what-do-we-optimize-46-hint-1, eval = FALSE} resampled_res |> filter(.metric == "mn_log_loss") |> ggplot(aes(x = mean, y = model)) + @@ -1481,7 +1490,7 @@ resampled_res |> The scale of these values is different than the previous values since they are computed on a smaller data set; the value produced by `broom::glance()` is a sum while `yardstick::mn_log_loss()` is an average. -### Exercise 45 +### Exercise 47 Copy the previous code and add your labs. The final plot should look like this: @@ -1489,13 +1498,13 @@ Copy the previous code and add your labs. The final plot should look like this: logLikelihoodPlot ``` -```{r what-do-we-optimize-45, exercise = TRUE} +```{r what-do-we-optimize-47, exercise = TRUE} ``` -```{r what-do-we-optimize-45-hint-1, eval = FALSE} +```{r what-do-we-optimize-47-hint-1, eval = FALSE} resampled_res |> filter(.metric == "mn_log_loss") |> ggplot(aes(x = mean, y = model)) + @@ -1523,7 +1532,7 @@ resampled_res |> These results exhibit evidence that the choice of the link function matters somewhat. Although there is an overlap in the confidence intervals, the logistic model has the best results. -### Exercise 46 +### Exercise 48 What about a different metric? The area under the ROC curve for each resample was also calculated These results, which reflect the discriminating ability of the models across numerous probability thresholds, show a lack of difference @@ -1535,7 +1544,7 @@ knitr::include_graphics("images/pic2.png") Given the overlap of the intervals, as well as the scale of the x-axis, any of these options could be used. -### Exercise 47 +### Exercise 49 When the class boundaries for the three models are overlaid on the test set of 198 data points as shown in the image below, this is seen again: From 1f65c09e6a41ea2d25871ef16bd6be8816d3e241 Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Wed, 9 Aug 2023 20:57:21 -0500 Subject: [PATCH 04/12] - changed knowledge drop --- inst/tutorials/16-dimensionality-reduction/tutorial.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd index 897c719..939ed5c 100644 --- a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd +++ b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd @@ -2814,7 +2814,7 @@ workflow_set( ### -Often a data practitioner needs to consider a large number of possible modeling approaches for a task at hand, especially for new data sets and/or when there is little knowledge about what modeling strategy will work best. Workflow sets provide an expressive interface for investigating multiple models or feature engineering strategies in such a situation. +As you can see, this code produces a workflow set/tibble containing 15 rows. Each of these rows represents a model. ### Exercise 27 From 669c01b1b065182cbcc09e962cdd08ef5d2aa351 Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Wed, 9 Aug 2023 22:22:17 -0500 Subject: [PATCH 05/12] - fixed code chunk label issue --- .../16-dimensionality-reduction/tutorial.Rmd | 132 +++++++++--------- 1 file changed, 66 insertions(+), 66 deletions(-) diff --git a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd index 939ed5c..5345bde 100644 --- a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd +++ b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd @@ -237,31 +237,31 @@ Load the **xgboost**, **klaR**, and **mda** libraries using `library()`. ``` -```{r a-picture-is-worth-a-3-hint, eval = FALSE} +```{r a-picture-is-worth-a-3-hint-1, eval = FALSE} library(...) library(...) library(...) ``` -```{r, include = FALSE} +```{r include = FALSE} library(xgboost) library(klaR) library(mda) ``` -### +### These libraries will be used later on in this tutorial. -### Exercise 3 +### Exercise 4 The data created by Koklu and ÖZKAN will be used. Load the **beans** package using `library()`. -```{r a-picture-is-worth-a-3, exercise = TRUE} +```{r a-picture-is-worth-a-4, exercise = TRUE} ``` -```{r a-picture-is-worth-a-3-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-4-hint-1, eval = FALSE} library(...) ``` @@ -275,15 +275,15 @@ Each image in the data contains multiple beans. The process of determining which The training data come from a set of manually labeled images, and this data set is used to create a predictive model that can distinguish between seven bean varieties: Cali, Horoz, Dermason, Seker, Bombay, Barbunya, and Sira. Producing an effective model can help manufacturers quantify the homogeneity of a batch of beans. -### Exercise 4 +### Exercise 5 Lets take a look at the `beans` data set. In the code chunk below, type in `beans` and press "Run code". -```{r a-picture-is-worth-a-4, exercise = TRUE} +```{r a-picture-is-worth-a-5, exercise = TRUE} ``` -```{r a-picture-is-worth-a-4-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-5-hint-1, eval = FALSE} beans ``` @@ -295,15 +295,15 @@ beans As you can see, this data set of 58 beans contains various details about each bean, including the `area`, `compactness`, and `aspect_ratio`. -### Exercise 5 +### Exercise 6 Type in `set.seed()` and pass in `1601`. -```{r a-picture-is-worth-a-5, exercise = TRUE} +```{r a-picture-is-worth-a-6, exercise = TRUE} ``` -```{r a-picture-is-worth-a-5-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-6-hint-1, eval = FALSE} set.seed(...) ``` @@ -315,15 +315,15 @@ set.seed(1601) There are numerous methods for quantifying shapes of objects. Many are related to the boundaries or regions of the object of interest. One feature is the area: the area (or size) can be estimated using the number of pixels in the object or the size of the convex hull around the object. -### Exercise 6 +### Exercise 7 Now, lets split the data and create a training and testing set. In the code chunk below, type in `initial_split()`. Inside this function, type in `beans` and set `strata` to `class`. -```{r a-picture-is-worth-a-6, exercise = TRUE} +```{r a-picture-is-worth-a-7, exercise = TRUE} ``` -```{r a-picture-is-worth-a-6-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-7-hint-1, eval = FALSE} initial_split(..., strata = ...) ``` @@ -335,17 +335,17 @@ initial_split(beans, strata = class) As you can see, this code splits the data into a training and testing set, with 13611 total values. However, the desired split should be 75% training and 25 testing, which is not the case as of right now. -### Exercise 7 +### Exercise 8 Copy the previous code. Inside `initial_split()`, set `prop` to `3/4`. -```{r a-picture-is-worth-a-7, exercise = TRUE} +```{r a-picture-is-worth-a-8, exercise = TRUE} ``` -```{r a-picture-is-worth-a-7-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-8-hint-1, eval = FALSE} initial_split(beans, strata = class, prop = ... / ...) ``` @@ -357,17 +357,17 @@ initial_split(beans, strata = class, prop = 3/4) As you can see, the data has successfully been split with the correct proportion (75% training and 25% testing). -### Exercise 8 +### Exercise 9 Copy the previous code and assign it to a new variable named `bean_split`. -```{r a-picture-is-worth-a-8, exercise = TRUE} +```{r a-picture-is-worth-a-9, exercise = TRUE} ``` -```{r a-picture-is-worth-a-8-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-9-hint-1, eval = FALSE} ... <- initial_split(beans, strata = class, prop = 3/4) ``` @@ -379,15 +379,15 @@ bean_split <- initial_split(beans, strata = class, prop = 3/4) Another methods for quantifying shapes of objects include perimeter: the perimeter can be measured using the number of pixels in the boundary as well as the area of the bounding box (the smallest rectangle enclosing an object). -### Exercise 9 +### Exercise 10 Now, let's extract the training and testing data. In the code chunk below, type in `training()`, passing in `bean_split`. -```{r a-picture-is-worth-a-9, exercise = TRUE} +```{r a-picture-is-worth-a-10, exercise = TRUE} ``` -```{r a-picture-is-worth-a-9-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-10-hint-1, eval = FALSE} training(...) ``` @@ -399,17 +399,17 @@ training(bean_split) As a reminder, `training()` is used to extract the training data from the data split. As you can see from the output, the training data contains 10,206 rows. -### Exercise 10 +### Exercise 11 Copy the previous code and assign it to a new variable named `bean_train`. -```{r a-picture-is-worth-a-10, exercise = TRUE} +```{r a-picture-is-worth-a-11, exercise = TRUE} ``` -```{r a-picture-is-worth-a-10-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-11-hint-1, eval = FALSE} ... <- training(bean_split) ``` @@ -421,15 +421,15 @@ bean_train <- training(bean_split) The *major axis* quantifies the longest line connecting the most extreme parts of the object. The *minor axis* is perpendicular to the major axis. -### Exercise 11 +### Exercise 12 Now, let's extract the testing data. In the code chunk below, type in `testing()` and pass in `bean_split`. -```{r a-picture-is-worth-a-11, exercise = TRUE} +```{r a-picture-is-worth-a-12, exercise = TRUE} ``` -```{r a-picture-is-worth-a-11-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-12-hint-1, eval = FALSE} testing(...) ``` @@ -441,17 +441,17 @@ testing(bean_split) Just like `training()`, `testing()` is used to extract the testing data from the data split. As you can see from the output, the training data contains 3,404 rows. -### Exercise 12 +### Exercise 13 Copy the previous code and assign it to a new variable named `bean_test`. -```{r a-picture-is-worth-a-12, exercise = TRUE} +```{r a-picture-is-worth-a-13, exercise = TRUE} ``` -```{r a-picture-is-worth-a-12-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-13-hint-1, eval = FALSE} ... <- testing(bean_split) ``` @@ -463,15 +463,15 @@ bean_test <- testing(bean_split) The compactness of an object can be measured using the ratio of the object’s area to the area of a circle with the same perimeter. For example, the symbols “•” and “×” have very different compactness. -### Exercise 13 +### Exercise 14 Type in `set.seed()` and pass in `1602`. -```{r a-picture-is-worth-a-13, exercise = TRUE} +```{r a-picture-is-worth-a-14, exercise = TRUE} ``` -```{r a-picture-is-worth-a-13-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-14-hint-1, eval = FALSE} set.seed(...) ``` @@ -483,15 +483,15 @@ set.seed(1602) There are also different measures of how *elongated* or oblong an object is. For example, the *eccentricity* statistic is the ratio of the major and minor axes. There are also related estimates for roundness and convexity. -### Exercise 14 +### Exercise 15 Now, lets create a validation set of `bean_train`. In the code chunk below, type in `validation_split()` and type in `bean_train`. Also, set `strata` to `class`. -```{r a-picture-is-worth-a-14, exercise = TRUE} +```{r a-picture-is-worth-a-15, exercise = TRUE} ``` -```{r a-picture-is-worth-a-14-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-15-hint-1, eval = FALSE} validation_split(..., strata = ...) ``` @@ -509,17 +509,17 @@ knitr::include_graphics("images/pic1.png") Shapes such as circles and squares have low eccentricity while oblong shapes have high values. Also, the metric is unaffected by the rotation of the object. -### Exercise 15 +### Exercise 16 Copy the previous code. Inside `validation_split()`, set `prop` to `4/5`. -```{r a-picture-is-worth-a-15, exercise = TRUE} +```{r a-picture-is-worth-a-16, exercise = TRUE} ``` -```{r a-picture-is-worth-a-15-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-16-hint-1, eval = FALSE} validation_split(bean_train, strata = class, prop = .../...) ``` @@ -531,17 +531,17 @@ validation_split(bean_train, strata = class, prop = 3/4) Looking at the images from the previous exercise, many of them features have high correlations; objects with large areas are more likely to have large perimeters. There are often multiple methods to quantify the same underlying characteristics (e.g., size). -### Exercise 16 +### Exercise 17 Copy the previous code and assign it to a new variable named `bean_val`. -```{r a-picture-is-worth-a-16, exercise = TRUE} +```{r a-picture-is-worth-a-17, exercise = TRUE} ``` -```{r a-picture-is-worth-a-16-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-17-hint-1, eval = FALSE} ... <- validation_split(bean_train, strata = class, prop = 3/4) ``` @@ -553,17 +553,17 @@ bean_val <- validation_split(bean_train, strata = class, prop = 3/4) As a reminder, a validation split takes a single random sample (without replacement) of the original data set to be used for analysis. This sample is then used to evaluate a model's performance and can also be used to tune hyperparameters. -### Exercise 17 +### Exercise 18 Looking at the output of `bean_val`, you can see that there is 1 row, which contains a list. Lets use sub-setting to see the contents of the list. In the code chunk below, type in `bean_val$splits[[]]`. Inside the double brackets, type in `1`. -```{r a-picture-is-worth-a-17, exercise = TRUE} +```{r a-picture-is-worth-a-18, exercise = TRUE} ``` -```{r a-picture-is-worth-a-17-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-18-hint-1, eval = FALSE} bean_val$splits[[...]] ``` @@ -577,17 +577,17 @@ The double bracket operator, `[[`, and dollar sign, `$`, can be used to extract To visually assess how well different methods perform, the methods on the training set (n = 8163 beans) can be estimated and the results using the validation set (n = 2043) can be displayed. -### Exercise 18 +### Exercise 19 Before beginning any dimensionality reduction, let's spend some time investigating the data. Since it's now known that many of these shape features are probably measuring similar concepts, let’s take a look at the correlation structure of the data. Load the **corrplot** library using `library()`. -```{r a-picture-is-worth-a-18, exercise = TRUE} +```{r a-picture-is-worth-a-19, exercise = TRUE} ``` -```{r a-picture-is-worth-a-18-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-19-hint-1, eval = FALSE} library(...) ``` @@ -599,15 +599,15 @@ library(corrplot) **corrplot** is a graphical display of a correlation matrix and confidence intervals. -### Exercise 19 +### Exercise 20 In the code chunk below, type in `colorRampPalette()`. Inside this function, type in `c("#91CBD765", "#CA225E")`. -```{r a-picture-is-worth-a-19, exercise = TRUE} +```{r a-picture-is-worth-a-20, exercise = TRUE} ``` -```{r a-picture-is-worth-a-19-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-20-hint-1, eval = FALSE} colorRampPalette(c("...", "...")) ``` @@ -619,17 +619,17 @@ colorRampPalette(c("#91CBD765", "#CA225E")) `colorRampPalette()` is a function that interpolates a set of given colors to create new color palettes and color ramps. The strings that were passed in are color codes represented as hexadecimal values. -### Exercise 20 +### Exercise 21 Copy the previous code and assign it to a new variable named `tmwr_cols`. -```{r a-picture-is-worth-a-20, exercise = TRUE} +```{r a-picture-is-worth-a-21, exercise = TRUE} ``` -```{r a-picture-is-worth-a-20-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-21-hint-1, eval = FALSE} ... <- colorRampPalette(c("#91CBD765", "#CA225E")) ``` @@ -641,15 +641,15 @@ tmwr_cols <- colorRampPalette(c("#91CBD765", "#CA225E")) In the bean data, 16 morphology features were computed: area, perimeter, major axis length, minor axis length, aspect ratio, eccentricity, convex area, equiv diameter, extent, solidity, roundness, compactness, shape factor 1, shape factor 2, shape factor 3, and shape factor 4. -### Exercise 21 +### Exercise 22 Now, lets create a visual of the correlation matrix of the predictors. Start by piping `bean_train` to `select()`. Inside this function, type in `-class`. -```{r a-picture-is-worth-a-21, exercise = TRUE} +```{r a-picture-is-worth-a-22, exercise = TRUE} ``` -```{r a-picture-is-worth-a-21-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-22-hint-1, eval = FALSE} bean_train |> select(...) ``` @@ -663,17 +663,17 @@ bean_train |> It is important to maintain good data discipline when evaluating dimensionality reduction techniques, especially if you will use them within a model. -### Exercise 22 +### Exercise 23 Copy the previous code and pipe it to `cor()`. -```{r a-picture-is-worth-a-22, exercise = TRUE} +```{r a-picture-is-worth-a-23, exercise = TRUE} ``` -```{r a-picture-is-worth-a-22-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-23-hint-1, eval = FALSE} bean_train |> select(-class) |> ...() @@ -689,17 +689,17 @@ bean_train |> `cor()` is a function that computes the correlation coefficient between numeric variables in a data set. -### Exercise 23 +### Exercise 24 Copy the previous code and pipe it to `corrplot()`. Inside this function, set `col` to `tmwr_cols(200)` and `tl.col` to `"black"`. -```{r a-picture-is-worth-a-23, exercise = TRUE} +```{r a-picture-is-worth-a-24, exercise = TRUE} ``` -```{r a-picture-is-worth-a-23-hint-1, eval = FALSE} +```{r a-picture-is-worth-a-24-hint-1, eval = FALSE} bean_train |> select(-class) |> cor() |> From 84b04705bf263ef3ceec5c113e70b0e52c035661 Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Wed, 9 Aug 2023 23:14:19 -0500 Subject: [PATCH 06/12] - finished "Local Explanation" section - added image --- .../images/pic2.png | Bin 0 -> 27487 bytes .../tutorial.Rmd | 795 +++++++++++++++++- 2 files changed, 791 insertions(+), 4 deletions(-) create mode 100644 inst/tutorials/18-explaining-models-and-predictions/images/pic2.png diff --git a/inst/tutorials/18-explaining-models-and-predictions/images/pic2.png b/inst/tutorials/18-explaining-models-and-predictions/images/pic2.png new file mode 100644 index 0000000000000000000000000000000000000000..a3c5b548527660a4e0e5d08b073d09444625f512 GIT binary patch literal 27487 zcmc$`2|Sej-aoEIick@iY;{Y;P%1)5NU}t-8~eU5GbVc_ZL&m>WY5l6$1*}Yvae$s zl@0q;1;QG((jxD1+|7I(JTk-yxN4ci8v_8q;q7e3t?+y@r~ z|N9}&4*0}#apz&=%lEuB$fw;*vdH_q?6Mo)G`v*qPkZSPg5pXwP3tWK1ABI(+lkzD zLOpMKdwLw+-Psly6*a2tuH&HhLjpx-swW>6SR8CPAe}C7Kto5~R@{bM)6}%gS0>=` z==J!td3(Bs$B$=Qw%R4_Ay|l}}7g zk_&3E?xT%_kr68nX`fQzTJ-!#L*c!9+r@r}aOQQkx9hsP<{vzGaJ98hOGn2#B_+jA z5O?AHd0kD-h!-zjtcLe>bajnwN1s?uL7`CEMn+EX-O8Pt?=$F-8}x78whdX81m=~1 zm){1N&906!n-z;y*nNBwE@r=7}e_)J(k;Nm$uyOgYT0aa5Sqgvl0?E6to0rfbz5Z6H z!gNGzsoOf9Z|^zl#vZ}`D}8eG1mS+y~W~<4Ihp(JS9!Tw#x(XoF*RMg&6JulZ3~l#=rKYh7JVK|yO&g3NA_%iQ}c zKFEeWK30P{RwKXP;sDB4cBDOdr1wZx(P}HzdpLg8V^pqXxbQ2z<5G9jj@=@@m&0lW ziIK3s1Wh{)vN}WuO8Lw`P6*&0Bqhp;(}hf3{?j(lK8u2P*73epH!jWIms)6+TZ-S> zsP5_Q-8?sLkY{q2j3uEvJ3B{|C8XA;3YQwh23GPbTQ1qH6NIdBxHn0WXe0V z-1_%tid?RVgBfXYb9_Mq48m_skgdN?nW@^UjCK2ZN)$&iw70d*Ki7EiqmlRYg_5UR z3u!XlADLyQ`sWu(#=WJkLsR85m4!E?S3gy#&5+#M*3IP5=vW3xPft&ZFU_62hS>6V z(ra%zjc%{H$1L?(KO`N*=Dfa2&Xhte^W94^7Qc1+GOr} zKIPP{%^~isJh;BTh8sRX8kwtYUvdY}Irf|?&K{M)To~Z)dQUb9adMW&_iu?;4VuQ`U|ft4+NgH@_>|M<=X=haQ~7Q!xWiIjMHO)Soz$E4Oal-0xu2b|N*yLNi1w}=pt+n*o$ZP8 z(EP3DycqwIu8o}?!PQ!drCVm9Qc^7PQqQuEwzj^#y|r>|2+N5ZaZ}Y{!E-%BH*$yQ z2wT+kUhb`x>X03_1d~sASv|Xq6o)9ZhijtAVuwyi0Fy+`3!LJ%p?5o&F({@TbW95= z8WY6g<$iAiQ`1EI&FG7+Nl zqc=>4@3W}oVLSDzgNZKe8Rmf{p+mb6HZZAjbIE}H9iBLmc|Rm@NI5~+PzrnjvXuRty`RytCJ0g z{22aLka~W6z+>QJEdO9Q+O{ zm+~xw)?=0sKptA`bRul|g*gl46opIby_|Y|ekyYI!R=jntKS7muwScTdheCb z83>;LWJ6`W+#a6vGjW#P*yrrGrwR_#BDwa(i#>x_&Libs%?v3Krw1*gzVhP*d5Q8%&qeqnE z4<|d>u5pITJCy8= zbx~&WqF2k~x?8z3lL@{>ofj;2p=S?H&3@s)May8vTN(H6 zVh)KTXw-#%2q(TC?>Q8BfM9Wnx-vw$w?-|h8I!a*Z2Rg})Sp@tlE@Qtg!h zJE3NYbU0`++w7?uj}4a(CU%<8`f}2YhyaGLzS_Z3yB^F}OUK>Ol~^s!mBCTYMaeGp z$(Oo4YDCE=$}STaaH5_vbH3GFi(SmE$C4xP6O9$WsYlI0Eotjuo^6D?5E79XoxqYq z^w5#I*6d#drCH*U&b4MvLVIgsup-H&&wHkVdN8_VIMRTa@Mec=tdia#v~l4izWl^q z;$`m^Rk9{KZPQ{$s2zE8Uj@of=o9G2L(FD#B+gdYKGQI1UBE6W zO8)3d;5d|?baC}Z1Uli#i#jNMlUI`Bbd;YNWi2Z^tWHYO&_wRF&(*Vf5k+n7M0<~4 zvzeUQMfjHf%%fqrcm3=SiP-jA%bw(m*H9;jetPJi*aEihAfCcQn`4SHZm1&@#1!fq zVnn1+90?VuiFLgG(1|N=z;7M9cjoPUi2sS}%Ydlu=@bwn4W* z?%VLWtJ{dh7E4pzl=auXOWpWDtIr2@FsP$M>S&jFC}9uFi7u-c$B`>HH-dM_w^dSz zlf=FG_D*J)k*T&DGFb9QIIlxPWO3e_V;c6VK4l|vnBb=)2D~?|^%k77?UB1Vs$cWn zxe~zrK$Dp9d#cwEerc{fU^;k|3Hz~uH0_X;EpLyK$iP+mE|W*q>?YpKe8AuM@?DW6 zlE6Hs&&EWIRA?b&v!Lseiq@L~@s{IB_Igc`3wX;6n{{>cvs&L%=sJ-gw&*)!+dZ+p z*Ds8{BMP@yobFgSpWe#>xFIZfx5&0`pZNx~al;mFE97*`%=~)#^l2ZZB^yUa zLQjvrz(3*$8>=ji%?YxVzu_*3i5b8-$#^KNcXY03-Pyqbv-s)V-5tKR6gxY+f~2Hl zGHm!|nauorMJcPQe$%^~HWnjHv;AAQ?^OKMUkG&$)g?Aq`HQ_vRf#r3jy?f{1Gc~4 zD_dpdpche529}m7!m|GREbd72)Z7o?VNpP!I3Um8^l#p)SB!7(aZOWOG-r60HXt=y z63WRoGCW-7@9j2Iv8=DB7tL)j2YB#5VE>)bYCEG(-cw29&nWTx)eJbo4nN2 z69NJP^L%Al`S~q#^YiD3!j1qN0YPPDXD{%LG3);el=kCv)LrSprMhqMp+VeqgF+{2 z)68QWUXJ0gBj3cnyF=4Be9+0s^O>mz{FBF}n{KQn#*|OfQH9*7KbsZ*!NvJ=r9Q~) z3QPTaGMiIe+O>IqdQYgoZgm@(+lM9{V!yL63=XzGsD(y|+xBrAq4nQ!X+mo(RAb#?VHIjXp* zNY~S|OiNpP?Z7XN{Rh2_rWav3ZA?gu_Z{%)PwkE}QMyomqA6}u@visVp07E@6k>EP%TguBezE_am$`~!qfJcCt~w&4C|{!ShVyey4>3=K=^&Q-J0a8 zM}4#$c}U8`(8N0a(twmvpLDeNJEn`Khh(kx^CEoALI(frPuDS6!m2igg+-nEF527M z&+}R3{wjC=Pxp6jTBNxD5Twn?aWgF_j zJ5E)b9+FdeAE&~Vh4N_`*mSX20vU?BN2i{3xAE4R&iZVq|I~J7xXuC=*%Lg#zdb(e z;V<3c$oUkmX4#`jYPst%e;l&PmVkzpRokJ;R=x+3=jS?fjJrV|aD2$^SIX)7X+I~5 zo!fsSKh~eR>M>0q5hH{9bph=;1|HOQndcpS?H*1BFKx!RBrIzx5ZE>76yYE;~djcP5xwbGabQwsPms9lS8mX!{%Gj^FLUD@% z0E{B#wfXbgN3xGUp!;Hg7Ci{M1&Ub=RPjVnC%h$|@*f1@Z0CIijq%h4eq0_(LR}~5 zAyGDiA!>U)AmUM?ukY+Hy3EF6^7Kv}F*SQL7I)*Q&xXC8GecMO-1Od@bUSy3! z8Yf%cS7}EhY}2aYmE~xhH$H}r_Aqw#=Iwp7(X&Igl_gMYDB0;yU71z3Kh4SBi@~|smhVeEmOlknv6;qD)hapNN7R>ZhjOxab@MmjLfK1hSTW`8 zP&+iDb`ilub14xpzj>oI3hR-xOa(_2Lk*crs+;f^va!Zy1=(G5!zDRrY2c7 zJ|RhJZ^vM4*MZcdbu~*hU$$*LfBw95^wzWNilrW>O8IZ{cSkpu2XF@)YMvcOmyNBx z(annJ&!t#TR7N@$DcP%c1=IE$rZz{{#;T_m9o1CXrVzi!pyZxX>zVGh3V?@Epu(VJcb zqzWwihia8*kuMS7yn$Wku1r~2E_4Y;@IE~|%HO}0c zd`gU8#IPC9XUrTdexgvGj1ozFjcz_VAQ&AB=*X1)-&P=`ko3? z%@R*?gj;RS>CHqIz26nqarqSew69;kB1$EIt7`q|zNpL>iWR2q2D>&D`n!$VZ?+O4IBwCdRH)Pvb>5Y;c8CYYe}0MqaUc4-*5&u-HU8K>XZ~#HouSDu05B) zmSSNS*s^URCCaF0znMIFtljNEd3g+1ZegPYB|ol>vqApF<138_sUFcG(PtdI${PgR znJN>N$exiBw zF0#vI9JL3EXP-O$0U!aAnHjYh(}q0y!*(r7q7GeWaEX3%VLohnjE|v~W;1B6IYBv3 z<7nq|Xt+Sa%xEY_LucU-tMa zV_cGRB@CnCKSkV6XdII`z&V(uV3Av~Eqg_Kw!t!+07S%~##B0F@_v{V+<7({e^>14ncmc^Op0!W~3! ztJHM-;P&OlpiRP!dTf5s=D9NAj>mmzab921q#)|hk;4hhrB_cJH9XGp`GUw83jeHD z)$n-RV|&2A=(@plJ_UAa+7S`Y7z8i!uI5Z*2U%y^AzDMP$p#i~q z51s6Z(-E>GcNL|7n!o!l7p8Z9w@B=6k?v5Q9ShrJPaNGDovuO)r_(F*fsV#yb5pzE zqu2HxI`eMsm|SrkM`@hi`!zqo!lHH3(pig|eF7&>{!IC%>$}+D2 zV%WB|J3K5*_f&4B-m4E!C@bsce0{RsqT)jXN?1gY-qF!fTT|2g^XJdnw{HDVc4z-9 zP%Q1@hDY%yx={ZzNm)wOanyCqhx1BRRaNwi%)lIIg?xH~f7mY;+6D$O;4K4@M4h8Be^pKM9Th-u-x0*Ot&-IWuHY7tHrCB7{`^L-+*>Dfa*?9Pu~|- zw_D`#-)pd4;M&pPNrslDD#94hEL-tsa0 zl@*7Y{DiLiD|cj52rJv%s9IJ0rVB2@wEGwQ&gk9uR9IzC?EmZI7}G~g!9UR|R5S9v z@4uHvwWFg$TT9Cl{I|;Ayo-v9^}&F6@%*_iXtBZ#s5R=Euf_X&w1_Ekl`B3l*E8oc{=GxH z{ebVj3|BhALx+5)2nUP19%MP1^*-%+A7#NMn+kyU2~WhMKWKcd-%cn*u%l3H77u(& zvk%rE{;tfP+Y`LSp5c0&H#Otk^#Q$>sH+`0%Yng0xbw0jbXR_H|6i_?#QzanAAblM zT4RXRk}edAIX(?=gR0=vUe9l*{(LCY zpSAHc5BONmuP>h}sG9j-42qy#FP*(|eA;ir$#3*+hF)i?h@mSCydkG|?Nqu2? zy6Gb_Yh%gNr9&Zw%rYCzFK}Xvo^Z3K5%cCFlVm-}`KRq|Y+Qzo{Z>+7H@G#VAAbhtZvLVO@puSb7riaT+njK zwwt?yLvU-IluzmN(hCc=EmN8!eX`OY1q`_gjUeBl)_GN-u5P82G%_sX}2 zXk}Rtv?h0@Tuusb@|Q0p;6j1CqHcfX>b{+kVK3`FpbM* za%c)*aT61|$ORfv=Qg$JO$)7?JnHmim0~V$6tt`$DmyHJs;xICX)AOux51W9iRxP~ zP=zwy5PhziRys#BzW~5lwNxYRfX{sJy5qyY-?$CC&L7krmlRlQO(!l^=4nhmEyy7a z^ha65O@#S2c6B@fdrgUQ6KCSck(uirJt5ICnaR#TPw!((xw(n=I!9`Vml^0_Z$H>V zys{|oVEk&2#N+IU>{ySB_H1=J}; zoalxv)w|z<^?Ffa`sb@$w+FYei$WE4};6(!RiuGj)D?iO12 z^=qGVvXe7!bBGe}InsSri%#@>_0l|{WQi~6OXYC+sv^yu&$88LB%Hv<`JE}XG3WCn z@34v8roB=Msy}*}pY||1UD|gIgUdTQb7u#W3yP6m#I8aYG5^47b!}3OmFU3o2hqYt z|5D1v@|aoV72b#?xj8|bh0v3Zbfmh^V;>x zVGmGpQeIzGRSjm?2KH*a04e%XL+HJb%BEnk{;{tLC^0Be?om9+_BSx8{BimztlNhw zHs)6 zov58}i*xeKLCLzz0#Ib$!E)^3TI_8;)^@7%Sn@QAbgFA|ulr>4CiQJqzW5nI)2{U$3tJ-ye~rg`Y4 zZke=>q#TxXKNABkpeXAt9jABF2fBVXvy8`zY;9exA_Hj7U{m+l-vN5A;I1 zpZ!90J&A}U@=G7uC8a&7Ic0J(=7BCQTGzdF7w4O&M=qSUen9BduR{fdr5iO%5Yl(4 z8p~}E!?OY+6*rci)dl1UChh1|#56DQX2jJIWP86PbxDVb?~LBNwwUWbO;r6%RCCP# z%tooN!25eb5$_|25KW}wh{5B7hNz2nXmwJGE?+B)s!k5qL~80d7Z}m_1KRdaq;KTx znGi}bDQLOMv5HGcE4Ov1SnQ;H@IWX+!~u^l?g@u-r%R`ex& zWH7?D7UQ2*sF8|48M~x$Y}?CqsY`Ug$K3!dSF~p7_UBhLr&j;s9vgU16Uc$n5-~hp z@%=2x_9ow}7sc1!Qc@FT2NY3!63seU5A^xvt=}KK$$E^nQMCWIIs1X|m{h{s);%Ig z!}*9rVv^R>uIGVe*2JBuP@K2i*@FOnj|*`}>~u6~Z)qFSMTK5D%mi>kA4D3L8> zDG5s5zgRpaQrDAtJb7|1DZ$IK0!8we^ulXqxn`@?S?2pjOwczTP!ygDL36ySgVYYP zxIK0R5eBWEgv7^rO`O8{1OV-e{;a~jKIx=yC*Hg(*&q9!`az#F@Amjovz=_vrfj1_ z5@(o`Y|g&utj+!oOAS&&ASSqe46E2HntZ_7>zR_o;RJgNjH4btM$9=*vgHkL)cBq2 z{0^AyCp~WRM~&~i=1k-e&cG~-21=0IPmoTH34F3}GtM-ZLeJM<5Q&y06?|4fahFdQ z$CMA}Q%n-8?;{UA!Fp%3V8Vz3`GYR$oX~*9v!vD827Zcn!#zWt*1AR$a=p6 z;b{PyC6biVk5ZjX;%#)c&Q&XT|L5X$jK=-i1|F(1k)D4su#O?z1Hsel`+xVwk}E6w zQ9&xi-$@G3U!qz2Et39Vt@i(d`SVZZ8EfrBe}-;*lL62yGcz+gDd|I$MQCTIc2-Uf zAw2wmfS}+4I8?u1me*t%ZX?;{yr^i8gh96H$A`?2RJ8AZ>#41-KKQ^85?NNDfodBX zI)EOIB-uJT^q@9EsfG|1#1AbjEiHlhW%SoKH8qX><3w6M_{~-a!@o(+KBDXH zNDtyIzwMsJTLw*ZHum|IvHaJh@Ct)SN&J@B*2zLPL0yye*ZBgnC+;ESM(LMF`OA&@ zm3sSMt>VASnnsYgzH#rkrU||RU^+bog+Sq2E-++(YTNVi@oDSojw!o;1k8D3D_v7g zE`X6!qCM2Iia#rEF;pZgrR;ODvU1|in4*eem2PVrv(Ij5qb8PG$QF(+-*e} z+}mwl|MIM;>4%*%k(|GHy8JKmmH(c~((zv!ORXBcNMOfjr0_-YSiNs`ccj)xEZ=rn zys7({(=8PI9KHX<8x4=|FnKJJ;F&Ni#wPL`qi4ga-=64U)QV}Oh7m{k zA)q=RjsCoVZtYD5Ho-iwpXz#gdVFe=W~WOAdcYc(<|1`=_8^prD@{2!Uc~YVx52_l zQ@k^xMoayCw_|BI${1j9$$($)3z_9U_s+h)DdqCkWgoD&roiLL0}pAnRc&pr6xcy` zrWC?zZ%XXj;=T8j>4(hv)VXC{x}|*e2t1J};SJjKW>-?mowMMT z(XB~puI9L?ZR>9(ZxLNv5`IxmMFm-keFg$@9&Ib&XG}%hkVfKz$;xA8t0OVf-yU)= znL}}{xwL{xu%lEU5f1ysmr~xv{?_Mzj4dWLwX77`wi%W_T81o2x%#t- zGO8D(TOEgA=oGWuxYWXQagauGIq)Lh-%X_fL;0Qftdd2D8i^l6!lk#4uy(%W)tBE<597ug1GhWTf>}bNf3O z`^*MzfCiH=SN5|5+ZN4R=RORIbEeZVweZyf3%Je)Z1 zCb+fE;A15*2rF`VzL|WYWo$fSBm+B+^h6U1f&PU?@zJA_V+jEWU~`Z6gk{vbGCPD8 z2<`U=1Gj7r$+`xfqJ4#Us%jU%?KH5C#rCNIu+CiJTCsNe`6UCYK|We|=<&I~ zWfDKai7c7UDA3?>*DaDAqS9jYBMMaEuA&m8`75SlE}P zzMs1PnV9kU*#N(H{vN=&Sk@q6q+mVRoK5XgEB1I>u^p?8q|d4S1+9_ zSHCo5U5VYUe5oNhvYO4n;oFxjL}1c3a2zJS&)`FHO<3{};(pb&6)B($=rOSUh#XDl z8*XgObZ`*WuFVLaK3xFWZsS)R3o(q;w@-N@K76Ma5pd3XJDvBDsq#0;bV>X~SfvBE z#N*jXs3~-Fy*MQy35FjQG(Q$eUD)Gy+ zL77Hw+8B=(ic#Wrs8*?tu`j`~sO75A-i`4a{u5mnfmbKW&mjCY2ab;Ex91%zgvdPZ zNcNMBfwNxV{I~>5i}l#%t4`RAQ$o)}wftTcr;1;%krx6#F z)cQgNCBD}GO1rp)=^FWG(c7X8_s1Wm6QV!v5jiD@=P4u`8I-N@#f+Wc&t$mpL!<*c zanr!ia7xYRhXncURoM%q@fA6K5Lqvg#&s|Ap7`ZB#;SMhF%!IdSGG>Hy{{sserC>SR2h2}1;^zVMi6xJki;ut@3;hK zLlu!QUDT%LWYi(@hJ*VNMJ2WKH3(_F!Tvwr)8R$JLHO$ol=Qt(p+=rz-QIyxlT{1A z%d`?Mdc8jV2`anE?C}~4adNDE)#lRVA&hIe{y|ogcBv_F3teO{)2&H~LoSjWNC6*A zI|N)nV%_0gXvw*;3{5nRxZf_M8ST-|>9Dy-!r>O4ptF$##{EY;5ptN4vk($4#~`U0Uce>r z=iee7{}diJEo=}ie7m;2Es>-IPd~b%v922H|6Ff++EH5~ z=?9%Lo6LH5)6{cKwORA-yMG5{|L|hkksg!%PkNiSV&IhsFhWGV2h7|QWw&3>)PIoo z0j9yt{1Xk4zd+%+p5q(lG`5*|d~s&xX;5B%@^vReql}%sea@RVpXeDFAcB~gn~SSE zMnaUjf8-qjmdj2}{Q`0%66%NC7{Dw66l&4DEDK^ouU@^%&d#on`hkaXS@#b}ht0o| zvMMp&wRWdh_+db=u;Tbq-Cvt?WPSzcc;);2#GmvE^M8k^9l|(Dj2r!m{{4mc-}b2e z3l`t*&){%40D3Lwu6u2xHQ?ac(z3TEbV~M^+#R#>innj;1%nxcO5Y(p5;ANd|I2XV zAM5Kro5cy$R~EQ_*Fw%p{|Mnd)&Bi;B~eDgE};@ag z0XRnGd2nO@o?Prvd?Y*ae%-nFRK(~?xJ%!>O(NR&BhPZ_#>#5(44$EHh)=6w*|T`Q z%j{nLfnU7sSDV-W!K$^|(*`O4(!v5^ww3TeduQho#N?6k11NzoXDPpLf$USzlJU^{ zH696+A>k#N;;~;iy#8$U%Gp9#p5(AZK*`bWXIEfq{ZqFI;Q zz6Jyg#BeemireL4-kNuwQ2)qPkf<);^q$J6AdLm4#=eU$ykD!1)JG3}c(h%&9u#Lg zWfbB0CiGq8gCbfFLZIyWjQ`eT{4@q4YUR!Dpzb2T+$ze@?J-I>?;UKWDL~-_hyxA4 zY0YF{pF`*?g3TWWj=8ve;tw!7ijjsOI6NMOXfqJLq|++q>_-}p$SxllMM0ECD9&_# zHCG`LQvlfd`o4(^e5-u?lu93nV?wM)A=9%2Hq4riyum}@o6{v#n>n1m3oWA1S+u3H zrSke>3s8}v>LlsS1^VNYpaJk*5gxz?0JoP!=Yu;{_T|s)je(!#vKbVClW=;d@T|(F&;)~(P*eFIo zbqH@E>CaNvXAHEoULa+g@^)Sg4bKnz^?A+^6C8d$UiEhz>cGYZFdKd=t-{H~+GCnR7u8F(mv`+aT78 zUM|+WA=S}o?C)!QBxNQkp%{>E`RrfvZ1xTgMTpA;3E*k)pgd3_ik#Tz3}R;yBagu= z$ujlbyc{NZ66M%xXL(b%&4(JcP)0Iz59Y38q93pAy&|efleadttCTI#n9qW1F0u*W1>sdYJ;=G3oY$g^B`b45xvs4mWL&< zQrZ>KleerhqwXzjmEoa6PfsFQl=H&ik>Ot7r$Wn_sTaLSQdr{8*%n3a?l(#iQ(!{5 z=T6#(X|UrFO_$*Ih?sursO=6;$aymCpuaeWI5Eu$`wrZg&y2ObM974+C6k}v1j2U7 zRqa@$6;AoEg^}-~7JD|paelFZ+J){lKM+Tp4Cl)rR0%=BH7Y`&a=Fkb>b=G)h_)8+G%G{}bOwj1(V$M#V|x58+_;kxZiB~aO;)N> z-)|9lMv68XymJ!bANRr@Aa}n5i>iS$Z<(*=HCV++V6=<`O(-(?)5X1wFD5S=qpRB2 zlADp13BFr2cDx!dAE*6HK4&`1dj4uC*K~Cft3-QGQbOXSVVpnJlRW`}VwBN0~8>yx^+>Jh$~vG?^KSv9_nJ_9jYF>1FOl5?BQToD7U{iF#Ft1chW04qgxOE9eYV#0O{ygy1VQvOr3miyTuZ(z0sd3c%ioU?J}jxVXFTd zw$5ubzz3RzTZD29oO;YAbI9e|1I_0fn+j{0S<5C@z3lchYG(?xf51-%O!6jS1DA}; z)YfltijCS6y<2;VI3qyO!jN1J7TKwVIUf4#0CJ}oJzl)G;W5YjF`gB1=<8Q$> zxQBmAKfmYne(Kpf=b;fEDfn8qZmon*weWmR6*QwyCJi=>+k)7 z<3&7Rd>oCD#NoN?j&i>KA+~wJoi3Y}L(k~j7r);GB`%&ic`^^_6A!2UY7d2^q@UnF zgjqJSRvH=?zsAe7>|#9fLwPO3W&T=NcVFmzOAz?MxUI4LkKk;`%pZ9W|3gmeUrZN< z9oL@|JuA?6>6{#u-Y*mS%(-A-L(P8F4nH%`XZymR@%k&sXwlHHG5@na*zHq7XH2#) zg>VWc7+m?M43Ym9cmEe-CI0!f^lZ}T_BUGZjb}3Y5K$3UdM@U|xplGyX@%~EZ0$x@ zxaq&_r(6&fB}$x&_`CdLg2FBuw|5Zyw{44C@2jLv4Bh{>C?=Di(I!oRc7j%EzpWW< zsY3VLRz0lig8|GNte_+dA@`eC4BcWPX51~lvB8gm4&Fk4F_~{=mS1i1=x8j2|Jhsr z&qo@g72bfq1d=ZfX+7!7gP2UuVe8kX@qTL=-c&>!AIdNUh3@yp^nP)W#wDdSJ(bzeLRFRI3?lWNkeMSKUqZQO;vx6?F8l#c z;iJuIXa7P(Ii-}1a`oOG3Z910_;Qor5q31@+4?0$q$wT|N~J2HF=9jDCcu5%$0QF3 zGj~CQf+^U3PThu(8ec-1_o4g18kAM4mIio;R1L2p2lD}Rz;;s!Ry=HzeQfvYnSYa! z84&Grk;}@;n&*qH+?Z2FbaF?~T|J=hS{L+VXq)-^{1h_q;}mRrtMM1^KN zda+p>&NXOz1iw?bVjRJJ$dqE3NUuz zcw1U8=-w6&kGefV^mQZvi?ob80@+)7D6{e2k2)V;9x#P8{o{2EoGS>>i`WY%r;QF8 z`vOtUkkA$qdxT~ZnfdtEbDZxceF3QnoxcPvAxK=md|V9(L*RXACPR{6)7gcMZbJwa zLL%&l@ZAl4Sr!Orq!xFXF|Z#)dPT&TeG{9{Ls(2~`u2`pd-I@2avfwoYk1mtvfui& zN1tnTH#j?E#Mc#&xhaN~v~*DhZbLjg^lsQZX0Sx@9LVvWnq|3CEkkWVq^eT&H#3*) z+E22-Uf>F3-#qauj`;S}#ffu^eV|{DkG2{rho@#WsSn;%ZiQ|Siaw^mR=qCL&m5&g zC`j>A6=Kw9TSI9|MJa!TaRO72{v#wa+dUCvuDYpsY5D8r^`HK$l-W4R3%xa#5(ZW? zex=R3_8NZ8Q3mfC?|1#ebn`C9<2|D76EPF3hDX55yo~-vH}PaFVK~7byIpj(%#fo< z&`e7Erqn=`>|&_eCm=YDm8lB;KNS34D-6V+q#HkSn279|L zu9%mDx^H+}eEdy>;kA~@AMj`jfmSth3JUBywejfQv#;&?VN9xWC?;TMZ+l&sB&W_G z$?X_s!otaqrwuQ`p2Y`6*`%dLMk7!SUFFuUp;#tl_lpJ$CfI9yx2-%MKa23ZKcZHb zHR^({To(yE6}Z!P3AD|L4-Ze$Oo#`vqnaoqiZj2)30yIFdgZ%Fo#4>v1PDx)g{8Wb zAjF{aFrmf)5(+|xG7nxSlby<^MVI?wd399ikPd%7If(FaiYtVcy$5FemLODsskW4WzOe0jv*<3GG0DKgoc`(7 zd)GptkbJsV4+wIs(e9D95$B^UffxGMSS^rLBhs8A!PKXactvRw_-1iRr2bcQsgP!x z8rE8C{eXph&H-psEdCWtYm2A06P})|Nw+*n{j!6O6BAb6FE48a!mqn^x*5U}*}1-t zf7vNvzyAh`e=YmA-F`15cL^n{qZsd*CdGguU6G191k1aVR)1|L&xdzuW zU!xn$*N!?wFg&^N39sC8w}2@07|;D!DsrXTH<9iBXuN+vREn)qyx!Rfr-S8rexPzt zjI~Szvh(gq*68rGCNP#kXMhy<47i^zGeO*yt0Np+4*b4UcqxU5`P@c02MuU$QEabo z>wAnh-gpbMS>6Y7qSuq}q*APWQ!JAPlmob`{hAz({-)(A#MHeZxfv$6vFA>|I!@hD zEP#$#O`N=s4#m(JG{%$h)!o%ZPyV4U8thO*4mK_H-Fj17Au|d4T)YnPfgJnXFe%#uRR zl{FvqN^V#JqfUu~c2?lm4nBoMp0dw!tfksu3*VPT@zl0oNx)-%O{0hmq`XOGOGX@D zf=bFOkGGgn{(k7;8F4!E^GC!DqGkHB&EYY@-{1uL@cA<}D2#~uBy^&q3Z}AzOyUpP zC*6A4OfJWKEBkPV34hQC6Jy1hkoDMry(}vxOn)0jmYAAyIUEn0B{#Y5&MQT1{tU3= z34Jkn_AYxraB0PsSF6@Kat)V-T1HPTq;tF=re%05Wm4!~X-mjny@lu4cQPzvTt88* zEx0P(h@G`MRDdQ2#(glv#;?pANgghRKCe=?W8`a>c~#@HJUgSUq|%&Rl776a{W`3i-Oqj<~xlbtW?Fq_($i=w1-gG?v07U-?fF?LVB&(_CxSHF_r z_+xD;k$8nXRpk4_OH5J&ow#`e-?o%!9=yU5S9YEJ4)Zp=mUyK)V8SlfoENc%EY6ar zRY;lXpRaI4P&)#*D)xw+U5oC>Q7*aAxyYR#8;O6`vaJzPgHvCgagkS5P?zjXzl!#3 z8+US~w*iJyVT5AScJD^x$iw=Vy}g6$nIt)_(q6kg5!Mq)Kd8?yWXAu(?FCahhOU8c zd@YUItn@JutJ6rkrb$PSCB~iqYr<+soO~(J-a;e*Z>gt(+HH5L1^pI-W02B*q=CDD z&AEQz6WDb#=CBiZ7ze*hn~K8EQh(OwF1JPHn?V4zd;F%~9$izJ(8DWtNXpxuS-&zO9688!xquejSOR&FYHt?pYIv+8ZU7hCymn#)UH|ED0))TL_; zT8oQ|PI^CxNSLDEYe-+>6*XIC&XVJDD7j;@%TfhGroYPFyfRq-5*X-@H zdPV2v=Aa!>KhFf_ttq1Srwlhkcng_72JtMsy417UX}Lugn4X6ATOEc;H!xK%@(jHm zlKMkKO1>DGU3BvY5y{W@drhLsp{v(tj~f|MG|tHJjdrW$L;6ow;om?vmNz1cLnHVc z-{qz6tbae4PtbH1GnWI%Zdr&gT)FcM2h2-CatnTY&)^vEPdtJAO@9=P6|`H#Il>kA z?X7Y8i@N_8e+5?m9gMvSSql^;5>%<|W8<9%x9L25?S5ItHlG@={=@FYfu4 z5OTQyetyfqja5MDR*)P>6@HwAzuc)2wD*pS57_O~RX|C4V`5^+D=?gdRB%@ zGScng2k^7JdUvk^JGvc^dT4ny#1W?fZJVrvqd)v*2)j(gkofNhNNmq|W1s`jPICGo zr-$x3Tz0n~gjv>F7f1qw59Q(QyhOs*04X*@sxDW&-^Ec{U?EkZ=6_xjO}{|b)b1;9 zJ+|+}W-1H>Nc7GwSI>cGL&h^_7^U&X!W+4^EH*ukZQrlVwOKsgevoLd2l@%pds6vZ zX4)dHt|3f5Fo9`=Ii;mtq0!#izkWE~DL8)%5O@zdny@5b`-|#(ZuyfQVg^E8-mJ$g zEl5l};=4hdRKTsR`tyrC48RmZ7-fayei+81&op0KJ+tg81DuMTNyb zNcFy4iMlTgKf?^M;dG91-pS-HPv7#&mQ=^(PTKljd6|AZ>^c#vfJ+w$3to{#R<*h- zJiMNJv+LQ+~$R+0L*5l#!;R+T>7G`sh}pwE4m2rsk2jzQ+1 z^kUjnr^`m;=9^yn0?hRoyi2DKqcPV777_6inQcJTD}=!}>vhJ|-#bb8?D1u(WKjAk z;;NJ2`M8kFk<5@zWIO}~Wwzcr0^$TIe!Z;9jcb6Q0s+=Z>Je(5=|=}xDjtxSGk{Sz z-jt{38uJD=M#LztPe*1D5>?IRU5~sjgkpy@?t44?kP4`9$-3dlv=rHLNMxZ&c%(1O z$bS>N{#n@16oFjX5Z8rqi0Gg%NSN=+y@cEp}4ht`oPu#AeK|Dy{TzX5%j zOJ6vgOYvwZeq{(Trgm5jeF-i^qFbV_-{pZz9ueDpiAa*AIu$b)@$qjXTZ8=_g$`i6)`VH|FQ z=+-&%@XBb!9Q1%)RepwrTXfA#!xtVX>}Z;Og0umL&slXL4g1RV*jg{h)R6B|fnM4p zE?>^uxvx|`_aS7mo41e^Y@XTBdN^sOxUs_2#f-7S3*2XsvkIAjhg4AIHLJh<=7u(GkODUKh8CN=-(`aX~L`^I6G#UY?f)fiY0gtiXznD8U-3t?yTfDXhPE4X5FnPoqb#3PJn!&!_6tSG zl=whCfGcbA1<^l6E=OSE0Ads?vpK;8kY7USY*{iq~KO*LC#l0FN0p}E-o#zIjOyX$BrMYXp(5TqQ z-D7ATe8Dii1@{PtFBZ>oMDwb1o(}t`ZSS`lbO?>I=v6F&6Xl4{e0_~Q= zm~Pvp>HMLPH(pfj>eci0D(awfhAwj2=Cd6CTR6GDQuZmJR@ zjrcKoQ&!1p9ANRsQ9gXjvGUp3sCl0j&Zju25*s-Ij?vkcwuH+aYd-iZ`wZ1nrZ*umv{T()5 zHDkG~aQmh0_eHFd@zS@*36NdRFh9L#qM1W|uAZp-dtDMo%ZFIsy^!Rs03K~z$ql|y z1Oiqe&t*|w@W@`zOTrOmA*{NDjYZw1po(5@71FqX*jN>gQ!)#A?zdA+9sde=A3BsG z36=$&$UFNChG@8xj?f8k@|JBhICrtDgLwv*yH0bMmtYfJwXM6t9%DPApL4>%>N*18 z@O<6XVNtBi3trzk=i?1Cz4r5`AA7PPb0&o+PRX}>1+br~M~RmGAJ*UeG`}R&oI=8i=@)KpU(|c~?=~klSsTo-(hGl~L##`lI#g z9bu@h8^b{G$(sG9_pWTbwG>rFF6Jm!JP2{&LLodI4-EQNZbIaKw?Z!Lk0uSHY zKvq?Xw_cr|8(KVqU-05lc?|OAcfOZ##JYoWUYjB1JH2`XEjl+}UKuuWt4C#^Eh*P^ zWn=JsekICRbC?^7hzRyFq?~oK|e%T*}XGt3N zkzJ;uRSoX;V~yDrC5*_IHI5PhhH<7csDm#2G4P{)WXmo5LB=1BYm+SiN?8^kC59+( z{Wj2U=Xa^+>s<4V?yeyi!=NIgBS*2)KuPpDu6` z`D$gsWL2zMPIbl01{_B1XPmEVi<1nGI^bzwt4xX4FvFR>fepARrir*5;>Xv=`Z^uG z?eY9XDpo)!*m9k1L*SD}C%xR+FHQ->ZEkvzsMyT!L9jXD4teT9t9u*?mfk0=98g$Q zQ7}(DFd=^w7I3)q=}O##uwWl{F69{6od`!Dkp2qb8Xa^=()U;Ry`V=4SpLzF5urH z!iW;%{KDob$V>M8omZ#pZw=&+qXl`PO#xeclaABRqQ92=!9zClvKZ^kXyUffjMc{> zd#Az<(pLYQGTTB7)0(}s9$qimNFz5DDdi33g-VSKyERr?nrY%8R=jol+>qnydT>HW zqyul_z%yh#45YV>6y}ev&1dHnX81fA7Nr%G`Dn&4rNmA4LD00psThdV2v6mReOiVv z+tr!b0XYlmuht5dHsiMN9`2y-h}j%h^BPB1q#bCt*^i;Jjc+{HxUoXC-la1JUYx!mMB zirepa)TEwodaSrD^6QAs5n-NoTT>Hj9tm3(yYwjq$38%{h<)3~ zH+2v!X&|A6fTCv?=+K3; zqMbLPDnoWyl#EI^(Pz4zKRC1^X}1_p1@xJw3k)u;vV+!S$t$8ES5a%}M%!aYDV?-= zX#d)`zFBkwNvhj zt>NAktn*8N#}==eySnw_N-S(cD=9sArDSwZRe9O^4Db#tPAxMHE`M#{Dem@^BL273 zrvg~IOA>3dF%qWv0;r_(P|Mg^GsV~kt5Qv=SF4!RXIf;E9fQqd!cn8xCAD(-GXZZq zzFVvS?b7Pf)%vtre4Y=o;Lo2a@tl<{G*>O)!pZ&{AZc&(y|5{-v|d!)NtL{zieW_B z*K@0w{d87{tu?T2Z`y=Gw=f+|+o%V9hs7-d?OB`Jq2>!NGW%U@vd$W#fu)#>KO<>6;B(UTFwjNjRSa zCn3L%Z+dUrmgPM#uFHV;U~wevulAOmW3sr4Q*t0YE5aPMmLKDtm_;jYhM30wl|Ciu zA=gAC)c@Wtas@9(kG$Sf+^5z7@t<@VfsKr`!nLb8AIGjcu5nvk5G+VSHi1tRmcVt- z>QQ0rm;O*n%%trq8a@L@a7%7#Ma09P3@ARMt$593IYDKrbqnS)YmTc_bwaf+V(&d5D+QqXHD9%0gWC=FSlSC(5;A#A)74qLSsnfcRCbZQf=C@z z0Hs(eSE!E^R5FyhvO{y;F-{GW&LY1Zi7wGQwbLG`iB-^wd4z3bK&ZwKnmlxrdMON1 z6T^;Pz2tt9sJ~d#AuaPi0S~+oMro?=hz`QYH@TG(txE56oVZK%Fvwk$`%{0b(IH0L zl@oBpTwsIYObZNq9Oe6x48_% z)@1K`C{|R|HkuS zk!m^6r#<^UW1vxEgUdW@Xc(JB{z8xb*WWm?{vNoUIoz{msn(^hH=6X;{Oy{kws>pz zt*?mc8LvIxha@G8ZUVXW6>rK`trjjW=gb`$rE|@-LT+xEE>>)ma3ikEiy* z!l9D)hm*|<;!&-;Z4fZrZ)Rh=`#T47k+r}~FgN#Pls3J#ApVD*vL8Tk`N&ojYFbpb zmM=|BC|{&LAm%m$-G}cfGh7&17ltklqI)z!^IYeeviUbuQ}Dtd%O>0Y(=*^I%BHLw ze=kvc+lzYayXV9@B1xI!@fmJr({vm!aEXz-J@d+9cVpnX;9&HhP|}TXRruAWw?GUi z&1Ebxp$0fB`0|Qv+nQYZ+8*hf2rMC!!}H;RX%Sul4mm^p4$&y51smW0zD02;?scoD zwH(s{l0{TrMb@S^XA5R7f7`DmY@AYP+d5#|8EfaW0Zy)2LwXS(X@5R_w3JMii@;$H z;blUGpIJ&}(yA_g^ot^mO*CrEd_Dd+1zq(BYFlVErp+vu%`3|nndegyfU%Sb#;yBN zotHu{^j1Xwz!G#GM?YqLKj>FgVJU63;er?iDVp9hJu4x}g^COe4cSlSXUZHsC!%6V-XC!<`f-BWW6Lx(1RnGfl8_z$-bo0UY;ZkaRMb$VN35yAlySMne6wsa(lly5@1c`SZFkFZNZ;u zUy>v6A{jQeJBtN>2SY9V|De;Af5sm$um$t}8UN&QimHe}7hC&fjAdqkk!NPSwL$n> z_?&g#^`Td6@Kh5HvR9n=VO9!oTFuMqJ*>Fju+oJ-K^9QHHXA&{sd&xpVpyF@XiqO% z>XCQyb9TE4kwcMf%3_kO9WzKyZQb}5G)CNjtylNP=_@aO2WIM+YfROBE?wM5oDI8@ z9@$?W5Tb6x*)XZ_YAD8-A)j>Wil+eu!o4`iOP^ojbPqVL^@C3$ekkV&oyZ62!V^c8 zXcIN2>WTbk1+*_uNN?+}n13(@#0I|FMY|+3<>>tN`UWmNF1VBN!BNhuCy3(06(QV1 z=`6OGsomR)y&xiTpF}*yc#12;@f5W1%c{KJixy^8Z>9?F!T=VoBj;VT3c-ah|Iv%Z zeG0X^urC6S;a193cv9@On|TOUT1%0C$w&d=v$D#4@)cnyRekLb7S`Cxkn_cTVSK(< z&ZpPI>6q7ekiES%RllA^Y7YvQ=m;CKR$|9uP3dZrQIc2|hotJqox)^>U4ohMLn%t` z@V+xRh&(7EVWH1((x{2ZzVoN`XyOhEAIf)`?7X#k_YC!#m7#G(;V9d1y;V?BL|*J% zx+qLk*#)<(hLi4p1-MuqpV$^DXe@)p>eZa{hN=_(I;bicq*qa?j{0P4j+@mneelmh zg_yfm(|Pg9(j3|$0)!{n-na>PC5XArPXMIuE!!AMUz$X|$?A$j1&g{a+l^RT(3x*W z)gH$5JG>c%ob)!K8{-}_j6TS3GjNN06cp7!S5|l5K+JEvwD}OcMCN4fHrH8{O6^a@ zdE814oBtYL^k4^>#cW+b2VRQPOD*hnBN^QeW?qYMpjr3^emr9Kx$u=wXB^dbhse^k zTQ28)IIwm?i8f_A0?%VLTlX+Zwbcg}d(CSjkmlQQM|SjO^2_D5roT)y{^WozLJx=u tke?t)?9qSfBc}gZIsFfR|Mah*^=;m3N^syFqsu@2akO=_AzTjp^FJT~W!V4# literal 0 HcmV?d00001 diff --git a/inst/tutorials/18-explaining-models-and-predictions/tutorial.Rmd b/inst/tutorials/18-explaining-models-and-predictions/tutorial.Rmd index 01de8f8..1e2cad5 100644 --- a/inst/tutorials/18-explaining-models-and-predictions/tutorial.Rmd +++ b/inst/tutorials/18-explaining-models-and-predictions/tutorial.Rmd @@ -90,6 +90,26 @@ explainer_rf <- verbose = FALSE ) +duplex <- vip_train[120, ] + +lm_breakdown <- predict_parts(explainer = explainer_lm, new_observation = duplex) + +rf_breakdown <- predict_parts(explainer = explainer_rf, new_observation = duplex) + + +set.seed(1801) +shap_duplex <- + predict_parts( + explainer = explainer_rf, + new_observation = duplex, + type = "shap", + B = 20 + ) + +big_house <- vip_train[1269, ] + +set.seed(1802) + ``` ```{r copy-code-chunk, child = system.file("child_documents/copy_button.Rmd", package = "tutorial.helpers")} @@ -292,7 +312,7 @@ ames_train |> ### -`all_of()` is a function that selects variables from character vectors. +`all_of()` is a function that selects variables from character vectors. As you can see, the code outputs all the data from the specified column names in `vip_features`. Looking at the tibble, you can see that there are 2,342 rows. If you recall, each value in the `ames` data set represents a house in Ames, Iowa. ### Exercise 8 @@ -322,7 +342,9 @@ Przemyslaw Biecek and Tomasz Burzykowski's [*Explanatory Model Analysis*](https: ### Exercise 9 -Now, let's generate some information about the model. In the code chunk below, type in `explain_tidymodels()`. Inside this function, type in `lm_fit`, set `data` to `vip_train`, and set `y` to `ames_train$Sale_Price`. +Now, let's generate some information about the model. In the code chunk below, type in `explain_tidymodels()`. `explain_tidymodels()` is a function (from the **DALEXtra** package) that creates an explainer from your tidymodels workflow. + +Inside this function, type in `lm_fit`, set `data` to `vip_train`, and set `y` to `ames_train$Sale_Price`. ```{r software-for-model-e-9, exercise = TRUE} @@ -346,7 +368,9 @@ explain_tidymodels( ### -`explain_tidymodels()` is a function (from the **DALEXtra** package) that creates an explainer from your tidymodels workflow. In this scenario, the function is being used for the linear model `lm_fit`. +As you can see, this produces a detailed explanation of `lm_fit` and `vip_train`, including the model label, the number of rows and columns, predicted values, and residuals. + +The code creates a new explainer, as you can see from the output. The `Data head` represents the first few values in the data set. ### Exercise 10 @@ -486,7 +510,7 @@ explain_tidymodels( ### -There are two types of model explanations, *global* and *local.* Global model explanations provide an overall understanding aggregated over a whole set of observations; local model explanations provide information about a prediction for a single observation. +As you can see, the output is very similar to the `explain_tidymodels()` call in the previous exercises. However, this explainer is for `rf_fit`. ### Exercise 14 @@ -556,6 +580,769 @@ explainer_rf <- ### +Dealing with significant feature engineering transformations during model explainability highlights some options that are available (or sometimes, ambiguity in such analyses). Global (which provide an overall understanding aggregated over a whole set of observations) or local (which provide information about a prediction for a single observation) model explanations can be quantified either in terms of: + +- *original, basic predictors* as they existed without significant feature engineering transformations, or +- *derived features*, such as those created via dimensionality reduction (Chapter [16](https://www.tmwr.org/dimensionality#dimensionality)) or interactions and spline terms, as in this example. + +### + +Congrats! You have learned how to create an explainer for models. + +## Local Explanations +### + +Local model explanations provide information about a prediction for a single observation. + +### Exercise 1 + +For example, let’s consider an older duplex in the North Ames neighborhood. In the code chunk below, type in `vip_train[]`. Inside the brackets, type in `120,`. + +```{r local-explanations-1, exercise = TRUE} + +``` + +```{r local-explanations-1-hint-1, eval = FALSE} +vip_train[..., ] +``` + +```{r include = FALSE} +vip_train[120, ] +``` + +### + +This code returns an older duplex in the `North_Ames` neighborhood. + +### Exercise 2 + +Copy the previous code and assign it to a new variable named `duplex`. + +```{r local-explanations-2, exercise = TRUE} + +``` + + + +```{r local-explanations-2-hint-1, eval = FALSE} +... <- vip_train[120, ] +``` + +```{r include = FALSE} +duplex <- vip_train[120, ] +``` + +### + +There are multiple possible approaches to understanding why a model predicts a given price for this duplex. One is a break-down explanation, implemented with the **DALEX** function `predict_parts()`; it computes how contributions attributed to individual features change the mean model’s prediction for a particular observation, like our duplex. + +### Exercise 3 + +Let's use the `predict_parts()` function. In the code chunk below, type `predict_parts()`. Inside this function, set `explainer` to `explainer_lm` and `new_observation` to `duplex`. + +```{r local-explanations-3, exercise = TRUE} + +``` + +```{r local-explanations-3-hint-1, eval = FALSE} +predict_parts(explainer = ..., new_observation = ...) +``` + +```{r include = FALSE} +predict_parts(explainer = explainer_lm, new_observation = duplex) +``` + +### + +As you can see, the output shows how the predicted price was given for this duplex. First, the model started with the intercept price, which is `5.221`. Then, the price was driven down by the `Gr_Liv_Area`, `Bldg_Type`, `Longitude`, `Year_Built`, `Latitude`, and `Neigborhood`. After the calculations, the predicted value is returned, which in this case is `5.002`. + +### Exercise 4 + +Copy the previous code and assign it to a new variable named `lm_breakdown`. + +```{r local-explanations-4, exercise = TRUE} + +``` + + + +```{r local-explanations-4-hint-1, eval = FALSE} +... <- predict_parts(explainer = explainer_lm, new_observation = duplex) +``` + +```{r include = FALSE} +lm_breakdown <- predict_parts(explainer = explainer_lm, new_observation = duplex) +``` + +### + +Since this linear model was trained using spline terms for latitude and longitude, the contribution to price for Longitude shown here combines the effects of all of its individual spline terms. The contribution is in terms of the original Longitude feature, not the derived spline features. + +### Exercise 5 + +Now, lets run `predict_parts()` on the random forest mode. In the code chunk below, type in `predict_parts()`. Inside this function, set `explainer` to `explainer_rf` and `new_observation` to `duplex`. + +```{r local-explanations-5, exercise = TRUE} + +``` + +```{r local-explanations-5-hint-1, eval = FALSE} +predict_parts(explainer = ..., new_observation = ...) +``` + +```{r include = FALSE} +predict_parts(explainer = explainer_rf, new_observation = duplex) +``` + +### + +As you can see from the code's output, the size, age, and duplex status are the most important in the prediction of the price of the house, as they change the price of the house the most. + +### Exercise 6 + +Copy the previous code and assign it to a new variable named `rf_breakdown`. + +```{r local-explanations-6, exercise = TRUE} + +``` + + + +```{r local-explanations-6-hint-1, eval = FALSE} +... <- predict_parts(explainer = explainer_rf, new_observation = duplex) +``` + +```{r include = FALSE} +rf_breakdown <- predict_parts(explainer = explainer_rf, new_observation = duplex) +``` + +### + +Model break-down explanations like these depend on the *order* of the features. + +### Exercise 7 + +If you choose the `order` for the random forest model explanation to be the same as the default for the linear model (chosen via a heuristic), you can change the relative importance of the features. + +Take a look at the code for `rf_breakdown`. Inside this function, set `order` to `lm_breakdown$variable_name`. + +```{r local-explanations-7, exercise = TRUE} +predict_parts( + explainer = explainer_rf, + new_observation = duplex +) +``` + +```{r local-explanations-7-hint-1, eval = FALSE} +predict_parts( + explainer = explainer_rf, + new_observation = duplex, + order = ...$... +) +``` + +```{r include = FALSE} +predict_parts( + explainer = explainer_rf, + new_observation = duplex, + order = lm_breakdown$variable_name +) +``` + +### + +Even though the features are in a different order now, the starting and ending values are still the same. + +### Exercise 8 + +Let's use the fact that these break-down explanations change based on order to compute the most important features over all (or many) possible orderings. This is the idea behind Shapley Additive Explanations, where the average contributions of features are computed under different combinations or “coalitions” of feature orderings. + +Type in `set.seed()`, passing in `1801`. + +```{r local-explanations-8, exercise = TRUE} + +``` + +```{r local-explanations-8-hint-1, eval = FALSE} +set.seed(...) +``` + +```{r include = FALSE} +set.seed(1801) +``` + +### + +For this tutorial, Shapley Additive Explanations will be referred to as SHAP. + +### Exercise 9 + + Let’s compute SHAP attributions for the duplex, using `B = 20` random orderings. In the code chunk below, type in `predict_parts()`. Inside this function, set `explainer` to `explainer_rf` and `new_observation` to `duplex`, + +```{r local-explanations-9, exercise = TRUE} + +``` + +```{r local-explanations-9-hint-1, eval = FALSE} +predict_parts( + ... = explainer_rf, + new_observation = ... + ) +``` + +```{r include = FALSE} +predict_parts( + explainer = explainer_rf, + new_observation = duplex + ) +``` + +### + +Note that this is the same code as `rf_breakdown`, which shows the breakdown of the random forest model. + +### Exercise 10 + +Copy the previous code. Inside the function, set `type` to `"shap"` as the third argument and set `B` to `20` as the fourth argument. + +```{r local-explanations-10, exercise = TRUE} + +``` + + + +```{r local-explanations-10-hint-1, eval = FALSE} +predict_parts( + explainer = explainer_rf, + new_observation = duplex, + type = "...", + B = ... + ) +``` + +```{r include = FALSE} +predict_parts( + explainer = explainer_rf, + new_observation = duplex, + type = "shap", + B = 20 + ) +``` + +### + +These SHAP attributions show the impact they have on the predicted price. For example, looking at the `Bldg_Type` row, the negative value means that `Bldg_Type` brings down the price. + +### Exercise 11 + +Copy the previous code and assign it to a new variable named `shap_duplex`. + +```{r local-explanations-11, exercise = TRUE} + +``` + + + +```{r local-explanations-11-hint-1, eval = FALSE} +... <- + predict_parts( + explainer = explainer_rf, + new_observation = duplex, + type = "shap", + B = 20 + ) +``` + +```{r include = FALSE} +shap_duplex <- + predict_parts( + explainer = explainer_rf, + new_observation = duplex, + type = "shap", + B = 20 + ) +``` + +### + +If you look closely at the output of `shape_duplex`, the values seem like they can be displayed in a box plot. + +### Exercise 12 + +Load the **forcats** library using `library()`. + +```{r local-explanations-12, exercise = TRUE} + +``` + +```{r local-explanations-12-hint-1, eval = FALSE} +library(...) +``` + +```{r include = FALSE} +library(forcats) +``` + +### + +Click [here](https://forcats.tidyverse.org/) to learn more about this package. + + +### Exercise 13 + +Let's create a box plot that displays the distribution of contributors across all the orderings that were tried. + +In the code chunk below, pipe `shap_duplex` to `group_by()`. Inside this function, type `variable`. + +```{r local-explanations-13, exercise = TRUE} + +``` + +```{r local-explanations-13-hint-1, eval = FALSE} +shap_duplex |> + group_by(...) +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) +``` + +### + +This groups the data together by `variable`, but the output looks very unorganized. For example, the name of the contributor and its value are in the same column, rather than separate columns. + +### Exercise 14 + +Let's reorganize this data. Copy the previous code and pipe it to `mutate()`. Inside this function, set `mean_val` to `mean(contribution)`. + +```{r local-explanations-14, exercise = TRUE} + +``` + + + +```{r local-explanations-14-hint-1, eval = FALSE} +shap_duplex |> + group_by(variable) |> + ...(mean_val = mean(...)) +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) +``` + +### + +By adding `mutate()` to the pipe, a new column has been created in the tibble, called `mean_val`. This column contains the average contribution value of each contributor. + +### Exercise 15 + +Copy the previous code and pipe it to `ungroup()`. + +```{r local-explanations-15, exercise = TRUE} + +``` + + + +```{r local-explanations-15-hint-1, eval = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ...() +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() +``` + +### + +`ungroup()` is the opposite of `group_by()`; it removes the grouping. + +### Exercise 16 + +Copy the previous code and pipe it to `mutate()`. Inside this function, set `variable` to `fct_reorder()`. Inside this function, type in `variable` as the first argument and `abs(mean_val)` as the second argument. + +```{r local-explanations-16, exercise = TRUE} + +``` + + + +```{r local-explanations-16-hint-1, eval = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(... = fct_reorder(..., abs(...))) +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) +``` + +### + +If you look closely at the first column, you can see that the type has been changed from `` to ``. `fct` represents a factor data type, which is used to represent categorical or nominal data. + +### Exercise 17 + +Copy the previous code and pipe it to `ggplot()`. Inside this function, using the `aes()` function, set `x` to `contribution` and `y` to `variable`. Also, set `fill` to `mean_val > 0`. + +```{r local-explanations-17, exercise = TRUE} + +``` + + + +```{r local-explanations-17-hint-1, eval = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = ..., y = ..., fill = ... > 0)) +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) +``` + +### + +By setting `fill` to `mean_val > 0`, the graph will only fill in the plot with color *if* the mean value is greater than 0. + +### Exercise 18 + +Copy the previous code and add `geom_col()` using the `+` operator. Inside this function, set `data` to `~distinct(., variable, mean_val)` as the first argument, type in `aes(mean_val, variable)` as the second argument, and set `alpha` to `0.5` as the third argument. + +```{r local-explanations-18, exercise = TRUE} + +``` + + + +```{r local-explanations-18-hint-1, eval = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(... = ~distinct(., variable, ...), + ...(mean_val, variable), + alpha = ...) +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(data = ~distinct(., variable, mean_val), + aes(mean_val, variable), + alpha = 0.5) +``` + +### + +`geom_col()` is used if you want the heights of the bars to represent values in the data. + +### Exercise 19 + +Copy the previous code and add `geom_boxplot()`. Inside this function, set `width` to `0.5`. + +```{r local-explanations-19, exercise = TRUE} + +``` + + + +```{r local-explanations-19-hint-1, eval = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(data = ~distinct(., variable, mean_val), + aes(mean_val, variable), + alpha = 0.5) + + geom_boxplot(width = ...) +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(data = ~distinct(., variable, mean_val), + aes(mean_val, variable), + alpha = 0.5) + + geom_boxplot(width = 0.5) +``` + +### + +As you can see, the box plot has been added with `geom_boxplot()`. + +### Exercise 20 + +Copy the previous code and add `theme()`. Inside this function, set `legend.position` to `"none"`. + +```{r local-explanations-20, exercise = TRUE} + +``` + + + +```{r local-explanations-20-hint-1, eval = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(data = ~distinct(., variable, mean_val), + aes(mean_val, variable), + alpha = 0.5) + + geom_boxplot(width = 0.5) + + theme(legend.position = "...") +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(data = ~distinct(., variable, mean_val), + aes(mean_val, variable), + alpha = 0.5) + + geom_boxplot(width = 0.5) + + theme(legend.position = "none") +``` + +### + +By setting `legend.position` to `"none"`, the legend disappears entirely from the graph. Using the `legend.position` argument, you can move the legend to multiple areas. Visit this [link](https://r-graphics.org/recipe-legend-position) to learn about the various positions you can move the legend to. + +### Exercise 21 + +Copy the previous code and add `scale_fill_viridis_d()`. + +```{r local-explanations-21, exercise = TRUE} + +``` + + + +```{r local-explanations-21-hint-1, eval = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(data = ~distinct(., variable, mean_val), + aes(mean_val, variable), + alpha = 0.5) + + geom_boxplot(width = 0.5) + + theme(legend.position = "none") + + ...() +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(data = ~distinct(., variable, mean_val), + aes(mean_val, variable), + alpha = 0.5) + + geom_boxplot(width = 0.5) + + theme(legend.position = "none") + + scale_fill_viridis_d() +``` + +### + +As you can see, the color scheme of the graph has changed with `scale_fill_viridis_d()`. There are many more viridis functions, such as `scale_fill_viridis_b()` and `scale_fill_viridis_c()`. Type in `?scale_fill_viridis_d()` to look at the other viridis functions. + +### Exercise 22 + +Copy the previous code and add `labs()`. Inside this function, set `y` to `NULL`. + +```{r local-explanations-22, exercise = TRUE} + +``` + + + +```{r local-explanations-22-hint-1, eval = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(data = ~distinct(., variable, mean_val), + aes(mean_val, variable), + alpha = 0.5) + + geom_boxplot(width = 0.5) + + theme(legend.position = "none") + + scale_fill_viridis_d() + + labs(y = ...) +``` + +```{r include = FALSE} +shap_duplex |> + group_by(variable) |> + mutate(mean_val = mean(contribution)) |> + ungroup() |> + mutate(variable = fct_reorder(variable, abs(mean_val))) |> + ggplot(aes(x = contribution, y = variable, fill = mean_val > 0)) + + geom_col(data = ~distinct(., variable, mean_val), + aes(mean_val, variable), + alpha = 0.5) + + geom_boxplot(width = 0.5) + + theme(legend.position = "none") + + scale_fill_viridis_d() + + labs(y = NULL) +``` + +### + +By specifying `y` as `NULL`, the y-axis title gets removed. You can also do this for the x-axis. + +### Exercise 23 + +What about a different observation in our data set? Let’s look at a larger, newer one-family home in the Gilbert neighborhood. In the code chunk below, type in `vip_train[]`. Inside the brackets, type in `1269,`. + +```{r local-explanations-23, exercise = TRUE} + +``` + +```{r local-explanations-23-hint-1, eval = FALSE} +vip_train[..., ] +``` + +```{r include = FALSE} +vip_train[1269, ] +``` + +### + +This prints out a newer *house* that was built in 2002, as oppose to the duplex, which was built in 1949. + +### Exercise 24 + +Copy the previous code and assign it to a new variable named `big_house`. + +```{r local-explanations-24, exercise = TRUE} + +``` + + + +```{r local-explanations-24-hint-1, eval = FALSE} +... <- vip_train[1269, ] +``` + +```{r include = FALSE} +big_house <- vip_train[1269, ] +``` + +### + +Chapter [28](https://r4ds.hadley.nz/base-r) of the [*R for Data Science*](https://r4ds.hadley.nz/) textbook provides information about the usage of the single bracket operator, `[`. + +### Exercise 25 + +Type in `set.seed()` and pass in `1802`. + +```{r local-explanations-25, exercise = TRUE} + +``` + +```{r local-explanations-25-hint-1, eval = FALSE} +set.seed(...) +``` + +```{r include = FALSE} +set.seed(1802) +``` + +### + +As a reminder, `set.seed()` is used to ensure the reproducilibility of data. + +### Exercise 26 + +Now, let's compute SHAP average attributions for this house in the same way as before. In the code chunk below, type in `predict_parts()`. Inside this function, set `explainer` to `explainer_rf`, `new_observation` to `big_house`, `type` to `"shap"`, and `B` to `20`. + +```{r local-explanations-26, exercise = TRUE} + +``` + +```{r local-explanations-26-hint-1, eval = FALSE} +predict_parts( + explainer = ..., + new_observation = ..., + type = "...", + B = ... + ) +``` + +```{r include = FALSE} +predict_parts( + explainer = explainer_rf, + new_observation = big_house, + type = "shap", + B = 20 + ) +``` + +### + +The results are shown in the graph below; unlike the duplex, the size and age of this house contribute to its price being higher: + +```{r} +knitr::include_graphics("images/pic2.png") +``` + +### + +Congrats! You have learned how to use `predict_parts()`, which computes how contributions attributed to individual features change the mean model’s prediction for a particular observation. + +## Global Explanations +### + +Global model explanations, also called global feature importance or variable importance, help us understand which features are most important in driving the predictions of the linear and random forest models overall, aggregated over the whole training set. + ## Summary ### From eb89779dc5472e370c5abee50fab34a9b51fb77b Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Fri, 11 Aug 2023 04:18:04 -0500 Subject: [PATCH 07/12] - finished chapter 18 tutorial --- .../16-dimensionality-reduction/tutorial.Rmd | 2 + .../images/pic3.png | Bin 0 -> 42580 bytes .../images/pic4.png | Bin 0 -> 44191 bytes .../tutorial.Rmd | 3330 ++++++++++++++++- 4 files changed, 3329 insertions(+), 3 deletions(-) create mode 100644 inst/tutorials/18-explaining-models-and-predictions/images/pic3.png create mode 100644 inst/tutorials/18-explaining-models-and-predictions/images/pic4.png diff --git a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd index 5345bde..cf65e23 100644 --- a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd +++ b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd @@ -169,6 +169,8 @@ rda_res <- ) |> last_fit(split = bean_split, metrics = metric_set(roc_auc)) +rda_wflow_fit <- extract_workflow(rda_res) + ``` ```{r copy-code-chunk, child = system.file("child_documents/copy_button.Rmd", package = "tutorial.helpers")} diff --git a/inst/tutorials/18-explaining-models-and-predictions/images/pic3.png b/inst/tutorials/18-explaining-models-and-predictions/images/pic3.png new file mode 100644 index 0000000000000000000000000000000000000000..2433ba6fba13ac50838a6d42321377257bea003c GIT binary patch literal 42580 zcmeFZhd-9@`v(3H6%|qPCabIv-jTg2d&Fa8H;jyI*&`)M+1Vo*j|U;LXGzGOrR?n? zd(Yo_KfOQS*YEc~{Cd4A>VEF~y07cJ&ht2q^SA`xQCB!eN=u4Dq0T8O-qJ#$h*D4} z!o<@j;a@(HNk4?Y2%NPPWKsDYbo1~Hk)@293<~uz?99P^V)&lKK~disg(7P}eiJm= zXPco=ne$4wWVGE)7KcxHN9)ucuQJ}2A+VyXOnatC!E*Xi#%WEaK9tsjY#FB0D)nB6 z>0Zl~MP7QZU!AY-s*;vH^UnX`vzyPNyJRU&UuBifP^LN(VQ2r>>U^Z?T3g#}O@U?0 zx|jwV|Bc7B&K=8B<QpISn&_{JKX?r1AHw!ZZK>?fzeLSHJt1JepL*NinoMeX^QA zE3SxtUG$r=kaB69v)Avn&hq_!k9_e16J$dDA6|7Q41Z!dpwv|#x~4q6bDmvcS}$W+ zin`@#h@;$@DwXZPOK&uA#LeAa+h*(RGvXJpO~%`;$unp5StXfnng)?eh<+c6nn|8m zq%*z}Xw#=DlOyz)_2^-l;!v#fgIQ{&QI;Qi|0J)BdSi&#yro#^NMs(6F30}5VVzrh zqdt>f%Gc;5V681U@fhjuD6*QY?`o4Y-00*A2hQA{l zHaGf8Q{mWTv{C_40R#(f`gWR*^YtH2Klv zCO@^!v#ia>Ja=}rjnQZ?A;G;Cw#Lz$b=a5wV0e4Dpxcab9Z+g=qh?Kcx@CJRK51$z zEHwM!$pyvw@tp)x!A&3Kon`Fka!OLlZ<(p6c0tD0t(SGi_5HVR-)^Bc^}e#ZHXTL9 zrQ4jRU)**Yg>rC#*kpLD_in>@=hbUN5%rTbht(Iq+u$5Y`{&puV|H87mw&{Qj+K+v zTw-EYIUDJ?(96gsnNqDaH~2#9TAc{7QCGfkmCKxVrZUxhe{Sr?e6ND<-aLE!O{>TX z*b~BhFil|&nwNZPv_uc;?6gL-BU?uA>{XA-tj!3{Dj5w`Davo!vGuEb$D$*S04;Z&GY_5Xn;V$=-!jCCzqz+W*6nUmoc>vF|HZVvKu|)DP7jb}4G{oOvTlobEgEdFkSm$-5Ci4X;)(X9T=4Byd6 ztr{y+nvxyqS7FPan>54NmwaZ=#p+t<-)%|wV760zB2s7d)nqf*v`y{RQytACz4H)HcppioV> zR*1&NdF*0bdlQt0t!Koktb>0gskczSrZ@blSIOJV<@2rJ?IC6|mO6Q)Sohl|Crik| z-uLM2uiXkGKjgn_)?CEBw>`>B-yq@QX!w!Hs$&?CF>g=MvzBV8byn5RmY(&)$mrGS z(NyQ-hxEql6`!hUS?GTgeV=ij`NA?GW$~p4Gu2ug$#rG;Qe0CcjxQ&j@=m8w$}JMc zlB7!&g6tv~Emz@-@_Om`$&ckN1(aI8LQX-ZOa zQ5|UXQ8)1z2@PS~KB-i^ttWZ&EV0q&7w0ZdEfmznShObumz9-azvUWL6p^K>Ckdxn z${ANZX@3oSUO^6-zI>DD-sJBX$=~x=>}(lXeV8ki=GeJ2pSQ1xv)adJ@i|#DiVQ3; z>&LSE8(d}@`u12+wr-BiHANuPazU}IQ}S)rWK+xc4D|Dkg6Q#M-U4q?w~SADy3H3S zr+9hQPHDtY9WTFl9x5OZz*AQ_}$RrAxq?n@1Y&O>EL(1T4GUAB3dPvGI=KB9~U-Vlf67TcJ9Zu zbXsn5JSiefAxBHRT!|VHGQ0^z5?_5ZK8QI-3|cr?jrtwe5S==u^1JkLV{2=x_64t{ zidmN(m)$jUdP(DQhtK$_kX<3FSLgZueKoD8$gr11Ciq;*t%7ZJ5>gebv_Y<(8g%m1 za$;Gfw%?(Ak^GF9r4NhH$?XVHY+FFf?{{H4V%8UC*ST09$*9bai1&A9O!<5W+Zd!` z39)_R;PvjU%eL|r(L8Nqli>ZnDhpJRVr6Vea^Plk_1ckg%l;A_$)O>ssT+-X6ELN46=C*kLOy}8-p7*!Upw;wOCmJ)|mPhuy6aqEsj*qHnAZv$0sjN>Qrl_zR zQLQ@Rbk6{dU4O~yIh|^MEhN;;rQ!#TNTE3Jl%gvhMt+t+(F5)Deb+drEGqE@N zZ7lBGrIwEupRu#Vy6aU*ZM8*Y)dhaFTD43XJ@DR zvVHaa9CE$vJ69yul@4>iU`+iE`|4 z|C7+!{83^?O#wacF<)$fq5BuZA;z{}_9T4Gyv<6tb%H_TNkm=R>$7&8X@04fw+B^~ z+vB*d_!%kv*&lmhRCiVDXz=FE=$sph1HQvrOQscEcX-#+2ZfUcg+{%ZA%uFzHIqeM zRX10&#|+w|b98cJMo8?NLg_64sobUce8FF#nM>_>l#WB3<4&pgRQzhA0AmZ6+B4fP z5wbl__Z0L+gi2ogaLl)h;6N`lGZnmEX3}k%MYo6vDwbya%r=_(rZG9S9yr5NJS=$3 z7FA8HQz`yi>!hm*hcg4^5hU(csveHvF3tI4E&AFxX2$;btBl;Ll1&Bb&VKqrR+^+~ z+DYpRX5AAJJ!_jTZ4WCQC|yse}3~>wEYwO>QzroLXKX6oqUhR<_ph1B|kRW zFzty#iJT}@Ap*z3vMd6;broh@7Pw>#J6SvfyeD@q#q;IG_Z@DZ+kJ$4cgyGH+Q4Ow zD2W;6rtMjXm*5cUlhZ;j=z`*4g?dq{(b{f@%Kur%IR9*zO}8WfScBxS5B!iNb1X z8JdS}PunCqdHsb-6L#AC`zT{iGrg5=6T39&ab0KBpVGK88GoXFI`-ksAH^Iw1=HEL z*EDCPIYbtit-kxA#%j6r^5-1ppmd75a>pXOVNo>TjTjel zR1a=z-Yap|*Rwz)YIgbU%l*|WS`#DdYI{TbF5RJCenWykGRDFr(zYf4^lyx;v-a&b z*H8*1j4Z4x&D9+G#htNT+{vr1ojK~}+88-(y((F!H)4@@U@6w-|EAYw`OW37wWB7^ z(RU3s{#eItUb{!@>?F&-XHDiRc3PuGEWRu3dZjAFEub9^{XM{l|7~Qt}BmAy_jb8 zdrcm?wkg^`Lb zFCSaU4!JOO=cQ!9<&(nC;^N}Gj`!=1y_T2#j`wSxogyCzdGn^Em4cSmv%uy@{=&M=GnX**8@hIZP4&EnhK5yd)*Gw^WB)_tK#j%_>L26i zk!o8Z5|s24z{e<*bR_^g`7E`>tP|{1;`)sh&a*BJFb?br_D-5Ck_5~I@Xr@7EiC*u zUdTSh#NbD{<3n^wXlpF*!pi(id!nc}r{??TNdDFj##5azRu-09m$(fw5?|)ls_SOT zvQtSme*HSPf;Fme!rzk$f6t6~QYYPfBMzUvjfhIug@l|E?7sKT%6)oCom|~^Z32|E zE}kbzC#a@~>zCRNUaj%mjHEVk|Ex{l0I+&G*3`Fq9R254i5e9O_46{GaWUYQhO78| z58NR$P@0;WVzsf6G>+F>W4NPS7Y626=HXLbryJQjR z3Sqb|to!POsEgKk6#uUZXN+B3egHd_Gy%%LO#vS$`&-MS1#%cpot(KY4uw!Ui?1Ts zCNWo>wpCwtgo)=Vh*fI*vp>;`J(=rjX=soWbz8E{=~(_@>i2fO7o*aiAmG~Th(d*X z;K?RaqL6(I$ptpWVvBa8qS@}{x?>)Gi?(n+^Y6{?WS+6OEe+w9iwL=^e+Yos1kH`n#~w&Wy<<&=faCgpa{L==%a((b|46fy!eTtE_Iq#j+gK%b@%d8iDFYz?RPb< zaJua$X*XK?p#fu=>N5ak)_()Pz7Cop)Vwi)XQ-9S?1rcM^-KkHhALfEf;6m8Mw6!Y zt%<>aCGo4p^9YJ6<)uq(NFaD_;^H}N+vE8agc$V3(V5C`RUr(-$^H(2|M9Pz`c+Rp z?CkE&Cl7^JhKHXYgh@S1Cw#}cFZ(_+_aE?+VD$1=g&kBpq;g}mGGAdQ?)SA7p1UkK zw-P*fA8yF-_lEEGE)f$Gw|soqlmWP9Vrj`vKKzo+Kwbo3o4J+wk{>4g5LPSK@B>v} zTAOYab*Xe;eZR3dh*plic3*x)_)9~BIn0x2xz~ET5E3imXYn(8AtX4sI}II5Co(nc zHu@GqJCP!zsr2!0vzfMdPxktO4~9rNQ#^;iI!e@W0#bqY&#B2tW(}#sPc$;}i@!=# z*whkO=tW)5+uPeC*@fc@vcVl>gUIN6($KI-nF?VHkz9H_`~htaWAy~PGl}*Y9_urE z>mXie$s-XqW_FdC*>!GXB82z5*mCv5oMzh`O)m$B!jXCPKa{Y#k<9peUd=hx{hZ`N zhGx2aPpyv^IbfuG6igGr46Y_@TMH1q(c!KduA z|NJYRZ(7Im^y$;JCPu$FKvYNul@`Uas&Tqs^_G2NSZW)unks2r`Q#5L#5%u@S?0m+ zy2|m-to!+N?grvY`rpZ%*oDb9o9#%3 z`r*HTEE&^<^O9F`4>o_8uEFnCV2xKBUYv^pXqG^6_suWk!rLL2M7@7O^}!ON#tiU- zVtKAnSOx`be%i3^XfO9H4d1QrZ@Dbx@9Egr?q<2*`jilwx$vVv2tw586cR@9FIPym zoW{Qp(~CBK`-Yo#&3P(7*8m)gr?$41&#H%Icd2R_*-$_5bIiuF z$!jXfPpE*ddh%GpkQ-_Q6c0<}dLjJv&sRujO6*4^=|!<7>ei*IOG6dyr|I5WpOo_6 zaX_}RYN8-g6&y^EE%uXQ{6de)9|O!2xm+|R6wrJeXVOzr%Kp&jVow&sA*&&Iy8~a5 z#F)LmO#b?06$J%U$nN^c$Ve8c<@pQ{Uapp<18ckdnrX@Dob-Ttkto zgox|fHN{^gHtZh^%LH|VnfqCMSH?a&&G)eG9;|mx!xSUwaTbyFq%U3Z{*s<|_oHl< zYW&sZ>h;iS*kJIOtc1qgWK!puHf#e1*bhPjlJFHm9~J0<`>MU?>@q7$9C{TdH_RGCRWGU$OMvaF8mPEDNk@4_0i+h&C71UGz5_& z86xxz6kvZ_>7D09)>g>|4=|pGefh?}wa0TrU2!a%xc;d6dg(!c8%XGsI}L?A965<% zQi0%A$v3I-Ja)Kwii|G2xmmG>U&j;sr%z|4>*GTOpZbz)wh5`@gJOJO#q!$cNP9=^ zPPfLkLY4T6#6PTxII=2LI}jq9S`ob%jfLa{+Y?zxP|6W&gyx&K#`NUqa5=|FKG(>f zg_Y;C8xlU0cyA&4mQ&~ZYZUpxMz02+{fIctzxPl+bs+18z`KOs=ad$8nG5%&{16J< zOeaW<_{^o~NLCe`aiVP)Ce>F|UyVNh^-7Ct_J?(yIhUgY4~fLgN8Rr&h!pMixBl=! z6+mRBoAx6^$RO!pkp4|s0a?jnZa9CAarcQ}_OHXk#wkFe_Z7y!1h#uIai3028ih%6 zor`AIV5spj#+SBm(f$Q1TpxCCHXt@O7MZ_)kY%yTD%}}@y(rn2m+3V9U1`22Gt+jk zNGnT~#+iyQV5P<5wt~V!S4(@lT97(t9&wLyJEsnRYJz}G*5z^4fyKr6H!Cf>bmH!Jg47{NU1DTpL=!WFk@8|RQh9i5HYiOMP^cgz?i9Nj z{SMNe0fG~pe=&v&4i$YAkR$+a&;&5ZbuOc{d3mU!7)v-0VMYVMD(|l5!NCEtuNM#i z$nrj=&wG2=t;l2DVz^kT-A+p*PXAK$=IK7j~)z zPj0tGFb5%t)Ds#0Hn!dh-dhVaEsx#l*i5ZVWecLgz?Bxq$3F{Y0-il{9h;h;x5|;8 zDfd0BBuj;PVm&%Ks$6CO3=EPNDjY!Xe7#c5tNawETvpdYvM=mS>kvq-0E9PtDuqVe z8?>Lcxo$5R(@SEfyEwf$p>oj3SnN(kX|Ql|eowl>-Dj7q6h=r)%98t**VN?rO#LpT zc>gn1PSdZh8%l(C_rF}fuvL$BB)uAoKQTR;^Ib~ zPFe+mIr{2I4WN0dLm{a@3cP{q{{8zs7!5`&q$n)mR@tNOs}f#1ff_gxaXtmvm5e7D zw`TSr%}+N+FgtC`X^KE;H>&m4@BEc(P?D2!F0(eYKSIdfWSs#;M+IrSJPwkA8sypQ zbq8x9DdQPr!Z2A2T4HY=50z_rZZC27=jsXRFfC*c=2{E&z^kna#3`LlDe3@hm)~%W zN)}tE(|5hrGQ~r_lTIfnfrhyL#`NB(@XTYBe-yglMHs!9E>e-_yVHY4K9GfGnzcmk z#R1QdoNdVzP)!on3<|LJ^4heP2&eCJV%ri6u?r^fcSK`e`+1mlQD>2E3+SsnP?0t?&TS~2LV)n+jgW{pYX(q&9&4N z2`}X|*}%5bbmzvST!$*06>5+6Y-+SKOzV8L@{L6J3C+k$ZgQB`dV4C|-gK5FzN07= zfLTm8VL_YLL0bG#wP;fAAcN2fsiU3rk+ZiqGcwX7@td`tI9sX@K`9^)#HuHY#&goq zjH9>E?T&SOIIcr8#Xxmj-Kl%Tof6wg5$9yLo)Rk#4`@aYJj_<~t`@#VC6A&u{ z*lo0mQ~LO-fhp+&2)%-&cgVyoFaw)TXsS}eLIf^5$XcsR93Aer0z;f`AeZVZAp7D$ zA!$xuvROu&tQ^bpK@I~;kw{UWpndPX@2Ts?mD&#;KFkC))`G}NX2s0M`bp}ZeFkl4 zfpL{CC5L`uGvmGN?!mt)Ay7pDHZ3{4ZGryg=Fia+p-B# zO*f<5``Ix~50StL z&NepbTN5q$^q?LGnv+#Zvq29gAq7>rh zwW+>)O0_!^XFLGAXToA;kqV~(ufwe$D z!Q!H{E`poc(>z6nA)t?rw(Al}jR?}Bd=6I{$UR$L>?ANc0XO6}tu@+i zn1}3j^YO1fxFbdu1BG1)Dx2%h*CHA8{ap$u56|X>ua$6bfy|W&)y)&bU49a|m$*lf9h;=X znDlVcB?n@JRmi`gonKKpv?EB0PiPc<)Wt-@Z}B?Mu&e`aa{-d3@H>R4b|Dn)0!Sk0 zz+z^Xq5>dt-yz$$%zZs8Tb=-+JWtK1y|c02DV4}MmIR7o{{Dj;>dRlgd{L$HuYoqL z{|N)27gL?7rj;)94>%p3JXhaxp8R%hcyb1*8!nuNrFk?2Mj;6#6F|&NeKy}d4+=u= zr5tme12_u;ZiXvS{)foDo*`uP=)`=x(CAGn{3KNXS0qc$H>!B=C5kl;L+R-jm`EJf zynEteRO4BKCG6k;3d3jJckOT!P^b)=ID8P<0#Apk+%#gY>%TXBo3CG-h5ZswAv)Lz z%8<)kG-Rs7TUGZy2S7PymY4OUim3lH)0d(i_|iT?I{06VqUxp)TEYR5YAk;ecI1KN z(^Ft7wc8|hbOq7mv4qX4NN`B^UGN8iM0tItU5&Wobytfopyqrz3^0JXE~OgW8-g8xF@k;2l$5LOvdoRb|*>km#dUI5l(RU{;h2#vAGg6wLy$lVF z$yABONxgnW#buG>pbOJ^fr=_q4g=I#1)`1>FL4CN6|#)qDSmlXeqXtngFl5~laS@f zrlRu$a=Qr$Ze2oLJlczMnw$T@iLVVwlF`GAWv*CXOHOYssW6MSxcl&Q>mT{aeK|TR zlKYGN6+Zi=@K$G$w_?(s19hGUVoQKZmIq(r5ra=6CJ4eiRu=|buhoBi`{ zaKA!y`6()jPQOIQu^ZXcqJ4Swpx1l{3H>45AJ>Zs6JPy$fzNT`7MdWO23ZvXTPVk+ zcEieYj?~g~W>PpWC@ybk1t<}6?kaeLvS`HkeU?Y-Gr@UlHqB_FG69UdYPS7*ea)8G z$i{7>NfUu{lS(v#AzD4m?PA8cK2t(205blV(VrEG!2U z&2sx@T2fdGv31Og)aNbNNXk@DldPZ9Z7rPMI)&x_yf)2!G-1Vm2Ai;>RQP%+ zPW*+64h*=G&DJVzr@zo+2=|biil*eqky)szH&>6BQFHLu;lql zooJ4u+wL0~LZMo<#PYJ)nh{->s>yY>gTBILK62y++qfxJ4r}$FmjFh&3hIt3MN}9e zO7*MVKVCN~zvJ!Wlj(c7mxXKVvrW>Ukog3hFp-%q@{yJf5e~a~?96FKSx#uauA|Ubr9Dul?z! z_|hkDBfUa^t0GQQFL(C$RRG|t_3vh{+@I@8)2eVXM?d9?m-4Gk68F$T3R-KFhNM*v ziUAQI@BRc3d>u)EXBj1pf;2*{x0i-JzweFIc&V}0S}H;@+O#FuED)vBG&9Ta)rvHM ztL;gwVg6O&t(Lu4p|41ilRdzw^~{ zS{f2TI(sQJ+STrk^n4PVeQ4+yQPI*Sq>TkbPDE7n26ZY?oeu{6+Qu(QWhggU*COv- z5N!-0N81*JmwpaTjLf~Kz?-ac-tBUfb+Bn&`SxDd^?sEnYC}4L1R&p46_8La6_Y-j zh%Mq^)@xFh=12^)St`pOR6Dd?R!U+CQzDkY6I>uv6y|N^1LrE>(B491!ljagSB5a z1@jFNmbRH}%%3m7{#T9rR|Yz37(w0KUG*C41SM;_ThVjE)X^{0X=LWi7y7Mo7{n?swC(qGlxJ7EeX(F)f$>w>4O2+}Ml!2;ctkm~#KG?N8Fm9K*jJ;rN*E~E(5XLA6iuK0!1V{lJ z*YDQHXX|U=wmsb4%dsfMGYKIl{2P-beGCW*2{$5%H*p_zu)gXzrA9;h8rJ37{d{a? z%qKx=c9)_sU<$3}j*}U(fuub90;li3O$ZhSaTN<-0F=66ZTc{raetAyit~$44$jU| z2oZaAiJP-ieEl_6Gz_`|3n>AN-YZYBDEEuVtpC#=Cm<|*m)Eoyw|K7q-gdHlqBG@# zrBjAw$Wb2OgRiGo*VZC|R3yBz@zlmY9B`_ri*-*%aI4=r(NE|r6NbzN2M+-NM2~qx zImon>q`G!T`rz;o1T|^mu#X=5Q=|M|b@p>O0A)A+Z@<@#|wY>j>wq z1>n0d1OIr!S~k*&INhofwbhwy3j3jg^7wM>00}BB<&!t48=k@JrqA-3WC`0ho>8{ z1u8RC9W5 zMbUD6(0M#J9gEa`(+kj*>GAnY7ntxd^GhEHod5TH5zme6qaUv%PHZg==aw}sjn>so zwI}}2j<^T}<9T3U%O|Ve4XzpMV0xp#*zyZEMc#l!qKpXTT@G7|`sl!1t>PCi&eB{( zIL1(ommY7LZk-&x45+}HS~3CbOplR8mhI!K0-;FXi8>DAS$$bG!;_ZD9On6>-?1;! zX!LchzTfa7i?qqS%A4okrRx=OcT6Rgc9;KM&0W2RO}2mZx`Hq?2Rg4>9}EPBlW6Yr zb!1o0sLL4A1CV*aGcZ8-+iaFvit+^WP% z0GPu_#V(|TXQ$9QxG+$@i*3KHAK$VC2y9jG!$Z|g04 ziu)Jsdm&vdN6@ythUoJnn~sNjo3M!@+LFcemX$>i_Q`xo@jEo|5Z%7JyL)Xsh%q6@ z6+0ck>8{1wL7+&F!@{MighnG&L_$#zJ@`id`MuopY6rsz4wuRan&)!@X!bxo% zZTlVn&_*rXg{~&jUpDdGHTM816kdfYNz6^1SB^(JJNztz_}#VHPJ4O(recr_^^44c z$#_4M6NKOlvzAhsZ{9jpbOt|BdkxBuFH4yJfmwiXU z$GB#D#0&2_$Pvg6*Qt?)k#GC04LNs0g*HT>JOwUn;|w*A;%Kdp8tXo`md;wJ3a^@? z7Bq|3w0AO6rgB#P)}2C1DsgV3@~$NFHW2UI3=0#O6+-9Y)p=`o-jk8|x4ox*BL&C? z;eqInWK`lMR=x62qAWO3w)m9;pObuw`vl4SuaaD>nNXi(9XZo_9KycKtn|*UJ_`t#0s+8+NLu&KWzB5;BIrC{O1rT5{z2m_PqyKX zWHGfyQBLjbcWxEL;fQs#@FjE{^kI`2{&Nhvs@A7RnlLc6!|{SI7;%raIbWuxFh(I} z)FLn(HGFpfUVmJy05&WA-G3wox2ZfhD&B0d`Y;K_2h<5J5FcEj1}h=_G>7BTHHVS z?`^o_v-q3ugW6I3(ao;_h_7c zg0mOiETi+ELXy~3yP@(c(6|+_99#w!RjcrxjPpt1OC`n0q^aO9Wr5=Dd$eoGPsqfd zU2g??_1e+?@`A;Lw65l7w6=Eiv?nJF1&eRxs&iO&B<(3VLNPG=_L_#0fdRVOx;N5l zDa(hGG7Mio-yn@X?L2duZ`M(ax8#!@*eEE^pMU4Igwj_MpefKye=*YDrwkjd4{nJ< zVFn;C$ZKL$MpQ^C&>J&Gq6iK%=uvx0 zN=hP)WMp?ifr-zt3HitP)^@`yDQ{Mmn=7BMr$UXttXD9=t14eoSi`g0mie`e!tJ%X zc!5$o9W(VSuo(n;FeR5*>wv&40cAt&PTs9{_Xm1nOy;n`Q1z@x z6BTJIBf0eX^XG9nA-@=|O>*8+vbD_;@`I!5=im^O% z)v+o8apiQ)1OMtvi>j&uS7lKUX$ou;NVQKhpGf0-*#506fT%zgY=Pdbc}J2+7A^p{ z`|`({wIIKzxOrbtF3YZ+677lGiaT|zE!Q)zPSEI`F=Vi_(4cwz%-lsm$eGg5OEKBgNeWy! z9?)t%N0KJeN(Ji3&z#TV%hvsjMq-uU zkCI!>D>~YO^8^GfVkR$!7tGGpz)4I~No^D)?cyZutqkJ?fk{k`*_ zA%+CrH%i_A7G+1b#E~Ae*XWbCV=>NoNBI#;O1Y2@F6=ke;&7E-KtRC8_RBiIp;^L0 zCLtl{)7Q&PmCq)uw-VGlA&v)tUvCk7qr7GC@j)ORoOzJkn`1^3B=y3(nu8s2k7@%- z-W)r>f9|hZpDJkKs{xN-g?uNZQ|~FcJ9Pn!W&uYAC4`$*Q_um4gd7S;ln7tdh%}_P zG;3@D1Lc;z2I(G%c>7D|!7}?)Xhd}vs$5tEY_sC~yG=>?uylTf4>J{tvvLBf{ox z!ykjo@M2&Yf$lR|Dq-vJNP(urP7eJ^P7_i{tP^kL27rP?PGks}jkcRMA z-$t$uKMC8ebYtO%hS0+lFg#)j2izvUlF*A%acIFd0MseK4DJm^B=Jkr3Rv~rI!Vre z?`C>KW5sEGMvb5FE)qSibJ}UL;7$Q4uM=Dl;R1ihEeB?p&8>CNhPw})cuZ?;1{vEGT1BE{OPb7Mk+Itp& z+dwNnd=r1~o^jw|KgN5341u2>5H-|-0+5Fh!jtj%cj?5!0^->-BZmM(`MYqM)>bbi zuJ@re<_B33&x0t;M)}tY8ZHASxPfsr7=&E-XJN1j6ihZy!=dR?nHq(`V34sQjW6&OJvFeye8C`y z1)2}$podrx6+(sPfmZag(e{6~#R0s-G+fDPs`(1IT?fR1!4;+Ad$6hiuT~2z2*);o za3LUCEg*}*T%zy|K{(X*f0Z0)Tak4?Cz_bA6Ev~uMElwZ;Kd8WR1iRqkq=x#rUNCm zvbq{UMlaf2WZt?#U={=2SGgc{YF?ARRxz+9TO(Kgb<&BgZf(T?O`q4-u->{5t_cXF zJFU0IYujaR1HrVgba{B&PJO6BnH@L$$G~BV_9#13&HMCp^NFv)2;!j^t*EHLUy9g7 zQ1u-n-s@^0EWI0~ymnGmplqEArQ``H`2~cA%@#|M~ z7t|k@)D(!-`N8X8KjdeYt_Fhe9c&0o%dbzv&F~4J`6TcfFu8WWzwNqnk&4P(ehdd@ zhAWV@A{it+6`_-cm^qM>LlACiDLz|}>~ym4$Owgj+*(HSG*|0sFC?-|`_WoFVuAH2Al?d#CEjAH1s)asOuZ zIxqnKj|J8(FBAib4h)}2`s@h82hsZx&joJ4-ciV=2PU?;_>XWY>>F_Af@c>xe2DD? zQmDw^Ti>1h_GTJvDzQ+_7JQ|1Xawk@_UwhB4dekztl7@W_!@Yc0N10E@V;FCMuA6N z()Ps#F^{k-N&=ZL9_~WIan-=+nfmA;Sy04z%~BXuFR*f%9739)dS@a8vPN1I>A%{} z*1|7)3@HCV{!sZ(@dKC9&ec`hCa(0_&L>OlJA3W!Z*r*vCWMB5vL7|^ z_V&gb`S8b2$D|<|Fbx=_Ua|G(=nLfGNr(ID1CQBcw+v{*B5Q8**F5?!qLtz6E(9M9 zjg|a8DkSirv#ShS1!>FTZHq1cBia97NT5~FmuoK0=(7=l1xGyujN+X;;Rm3B}uCF;FX=)Kvm*8@c! z-4fSUNncM2yQuyu{E-n$nyTH^U1Fp6*Se|y2RRu6>bJy+$KW~Cs`K>$CiEFJ2^KJo z%v^t%Ao!RQoR~K)2UQ;L6auGrj=Aw8-#F@u+zZ8cK66!K2iyO^2a4~(_h^oyCw~m) zyV9QBL`r^y4*29a!RHZ)K(#I`V%8$^{{Z^hcko7KfPWit`=A5gA8q}r@e)eAkVGbd zr0XPqPeM#g63fOV*?|g&@c=|{c<|tX88{4{tJlkAOW!8u0v_G}RAd5L_(@$P>VMOk z5=gkl+r&yg)y{3X;rcj`W0HU64xJqB8_XyzaDl{;CihVq%d!h2qB#o1{vL6SBhG>~ z2o$i}j{p4l5ZU2C8T-?EojWBgvzg0> z>w}f`og9XeRk;~XG&HuigB?+kOOHGie7tO+0AFzl=*1@o2ics@JBVZa>Qz~(w0#hB z+E4RA-_;lnsOWx3AWJ5_cHo zV5>+&3%Z_45Zh{0(iToz(5e%x1U(W)ONSpV^_`CoZj+oo9gb)TnGdXY>3ih=h-O-F z{6`P1b5M()^&0^8Vb!2DG4=|d?2T>#L~`B1_l+d6!_g}aSFT)HgUk^E{SnxqBVbgB zDh||uy>%5{@9&ge0eH|qjt1Va(P8_$%wC9D(Hgi~k?*1B{EvcEKq>YZa+SBv0n!NA+5ye0SvKsL;K-n^QrG0sZs^0KLP%Mf7=z;2Z34?l^&=85>?-2;q#&dtAD3u zsA{>E3yyE}R+VuZSN3Tew<0GHU^B%)H3CTw@1-NSM;uCtj1ofdxw`*3{5mLtV|qH- zZ6pHhZmr+eaO{r|<4?Qo@z z6t>E7@&%2fB-ETf{$x(Q{5&}f-nx&{wJ2FZx>~ z@IAD>T)*=QomT7XlgQtw`~U zhfSd^3XDEx9jNjIC_1fR!r$Qg1UTSjVqzkVqpdYZ8mm#q*!KYNzGu%W%RV-aPoJ`Ka_xo#;Nm}r1-GHdiLqCRI}gxZEE3);STM3$e7yk{ z8)am}a~qcSg`M)BYzw2rNf2C~azLj`t!)m7R?*XL#c%nhG7pWd{rIKQkGCV6{OL zkEs@2^-ciqA=xBJvi~Q1oJl8SvrTe(zk2m55^+C6YurXY@A1|mP{Y}QDq|3AZ&1i6DAK%G1Z;nHy}lb(S%3?k0DZ)~-k$*Jh61GQ zXk!?^01M}f-w*D#)@4;td6mJRlmTX}ENl8$Uef`Mi~WMLCr*(?Bd1U(Q29*!4H*4m zixwb1^6-vG%N2#{F$dI#$Y6Log{NnN^%ew65?L~`Kjhd;WBW z1;5F-GN6ET&tqw#D6$Lli*RDz#AdAtgHqAk93asfO@b zNTi;NwJtcz7PtcD+wA<`v3vlF6XIQjgH-VcfI9{&e-B46D{Ne7gvD-#6p-n?y9P0s zt8Bk>3qHmW^9u&T)KI&>BsP5Nw!mdQwWea=@cSEUm52d*+7(zLKQn5@y>%%IY{@V` zS6vACkhTHPlSV{Z0wC@w{}hh!w58`20z{Oh?a65Yk0>@?c}jDx8nC{P1%%3FTR4w$s~*9Zhc z#VfZU3pklsQH zLJniYo`yy!DvbS#x7O)o)IPpQ`449&r)lrFAm=P3u_wo9J_6uCvX3il5y%Vwv5~^u zpFi)y1vGa!y>npUX_Uk^*>kP0*20OgnosK7AK`}s{G}nNDx|u?krdjn{hggT4^K}IpjP|UMPNE^e4dM2GURH?46R^5DxU?Ll&0V{{WA6J1&tB9YvaBf%(GvF`~5f^~|3F<^32G_26EG8wA z;KWJA3a4oVhdbQF@403{kTGL{Zy>getB~kofdm2wzZFagEvRF7xhBvW#%dAR1&!f0 z8kF8UT7g&&^tU8}!O0*--*Av~zpL=pupn*fR-E>nHXQMGhC@*f+C&--oM~xkMKH58 zd}gOLGJ0fuj)2ZFAt$M@C-{LHNUbHo#;3nVH=K z(3+ovf4vt0^7>q3KK#5ml(`mdlyEVy6-p$;>hqBUO_&HNKi>*~g{q{2xE{P$-30qnw=u%{>`;e$Zq+E1s9eL9_r|IcPP?c!klzbnC>A}sL*DJY@rNj5m>nzs!F(MieUB^ZyMQ4ix&c{O>9{ zk)_5P_Le`vQjBPTPOB5Q(F8>%aLmNjAzBm8FvM`6vlIc$n1fpuIVu4)7;4cpR8K^b zLKBR&UE(pi1_0MFycbi6iYzW?Zq;e1b?xj+hYZnzeNpLD)q0IC2`Y&G6+Bcw{H)jHW(B6x~A~Y`ZUR z>8y1Q2$`={`SMvQydJ84$n)f$9lhmOiBi<+zq4V{pHt5EcK4%YYUiSk7SH0`9m?z;ooNlwwDKiA#s000{ZuKt;*0AacvHD| zRQGE2Zv>U)JX`hR2vlG+Z+^ zGKg5OlfM$9+^aScJgb7gsi zsh|tHwKMgSN9pbgt(8QZ;gA|@yf?!{@2JY!6#S5!x#i+ptq#A3P2b1%Jxe`TOX*XG@? z@O|dj&29HemY|qZ-}fI+`dNU6t490D$CNOZQF(P$Vn-Oa`nAS>uBoT-fKFQ_O^Qq+ zV0h>;RwB$iR-x_R+P6zf7We4fd4o4n_4(S+~6Vvs#wBUp-WD zE#kB9gwTH0O~%diTaEqcGbQ1vUOqhI+o{17!P}p9wu2LLF%{|Ni=4b?b= zUnKo=^_g6Hdq1+}9y(<}CgB*iRvN9pRFsDn+jUnjr+f8r-Db{pB8A0{G{!&lO@^{2 ze-x)1gQK5whWCV*qHL+S=Td#?@vgK*EG@^nf`XX zGzXdm>Rb=dadZirXYJRDCrTZqt{Oh2y>dfCG}q*wxVN^EC#rlY(+?2Oq*baHW(;Q7 zz&^+Poa9!1KYYS0Ymb53TKTq3@V3-MtpY|hvR|pLoi{Hc>^NReUj3Ennpdj9+QN28 z8{-qX7~;f)h6;`dQ?iKE-|f*6_LUNMJMyL}%6^=HcH^hBN7u#Q(x_VAqV;3rKPgms zJSyXNBy}!ag<0QuVs(oKy$gTy`n%3(N{gme=f5{ zP%qNm8oZ{-`B)>&^vM0S_kgH`MrH&>X<9FGdP6my&w{99HZm`TmaV#56|zu??%=sCa*dbwgqcZM*`{KdeG~o8bo7>)Wm9PKCV^0rt?DFV^wZ z85J(pNjOWbwVQKSB)zgS_$G@3T|Bu0Q{AX?ln=`_dRGY@$H6%WF=9+X-&R z81E0UPj9t^@k>Q8Om}{t8abDt;$X%mS#iThUDW;8hB=lwh5lE|SiF^yVB|K(`pF{F zw5SvNDpQpn{C~(=(nJbW+Bx9|$}H)Kvn)Q6kM(M7PD^EOthx0n#QB_%V}ad>%grXT zmc?%ZnK>eA@m1QJr=#ZJ$L7F5>ILpfK&Jd|=0RGi@?pSddZ8jUc;BxxW+mtek$UbU z5}K7F7m{|a|EIn4ex&;CuKLb8h_GD;;|IA%zNGD0?4m6DP@vXgm^8JXE5 zdt~oXHd)!i_jSE}KKFh92jA}x-+uVqx17#+pX+^Hukn07UfSEi%=aG2MEZAzryI5( zq3I%e=aQ<3jSm+uQ2GC?C5r=Q4m=%Bmz&)U4y*}Efv7L5oQ_p3%?_EdPCXgstQ8_$ zUSrKGH-4&`B^ifbkqA+>md<~#(tCWE;`W&0{mkvbPtb4$c$3f9R!}D8@Q*x{Lftv%Dt$c_oyePIis0`B53Yz!NzoYR&_U z`Q-)v0u_&bZP3BTvs2@9s6o}rYh{r1b0dWsG6TK)^9}?DLMsPq8w?1>*-pHg;stpM z+5`TIzh({|;^2|%wW&WgJ0?@zUZ2DA&5k}_NhTrH(({n_(LIL2?>{JB>eJ%fc503lU71XKPLiSSpH!acSpY0K5K0 zsuR|nGaIdigl2Yr#=kSd)NY}3rIr63F5_QJ0VRrJjyEY}V% zRc!lrik?{hzNsle9aAnLkxG6p+Sfx%jq%K)r@x%VubD@md*0btOkJ2arnxZV zN552%Dq`LH=);F^bV_y~k8B%Xr8-y0cw4-3^RLXNHevLqmhOY_wS`7_8A4^p=(i3% z_2$ORyiM94KO=wsvdgcWoCc!^6Zjr|{|U;fOjJUXUnU&~vljG$`5sSXKdc}@8t$!A zjU>)vmwvJCG29f9?6x}W&*%1t{_?-QBpMMW6>zPm~2 zma2^Lb4%6@nH{3}&2FVl$3lKZ*0qn;UOE6yQnN?Bm6tL@gFZ7qY^ZEb=^7Z(DKU%- z$!)D%BHa|~s{EiSqTX-XbNz3puMkaOhk%a*J;j`tMta)729MpwtJz&6um_##lB0FD zyZOe;@t7d1-Q?b?k9lVoW}FjeXK&3i2Q9l+RTk*GKX1AtDHdPc29!7k%(qkD9GH5anae`Xhe9_tqOHj@gE1L0`@Y z#rOcV!ex(QNeeX11T^RF@&@v}YSR~iixS?d`0ZINb=CM-sop|sSGt*O&S^#VSvK3Z zs=wr#e>t8p*y=5dAl34HJE*X*=AoB9dcF5rp0ba4edv3edyzRSspt0j)luizU6uLn zC@iPn=zeU;zo8%^=<>?U*;jd&gW{d$0w7@cNz|q==Dl~$+?dYbuPE8`-JLh}Pj6}D zQ)E4rzwz!&N3FD=)gpzLqEKJP$dRbyyb+3KEaK+^8+_GyPt;6)aAOkZeD=KHwdG`o z>UyCvd)JELOX&lpx(lnUE6!JPga;%vzD_Z2IcY00S05qj4kY$HuKMyt`!jbB4U<)f zV^YyJ<%+Yhclay6IwueJ4S_{u+pQncZ5a>zotc8y61v_3GF3 zjzk*S)O->gz3g7O)@5d}wxPJy*EPz)N7xinJjE^(_{`7OX=^jqbSft@V3cSZ#AIw{ zHy{2;?pLQ%p>MwzJ+D`FN3zy)0uL{g+|wek79%%up;0k7Ch`11f%o19o)*b{@?Zq< zg@SM>3GQ(gbUs+s(il*pKrJ@sTBrMZ&K;C8`@iHv0Dl2<5AwfTX}Cpcr#qM}K1(;KqvcaXufqdXPL6;cRj z1SQ2dh}hBr?$W3GueW1Y`gd@u=tAFl-L$Ok@5V)?S1b(Q2!l*KJc`?&8V;(4Pe1~c zgLQtBAZhBVhLV}|Zx<#_M>{&<`?!vh6@PA6o1+ z;lCM3&Um(<)$vb&w^E$$vtT-uEA8L8#&;+$2|io(HCui2{UiJIIR5Rbr{_f$b@m;d zv-<}}v%RgnuL6h8_qROMYjYcIy`ig*GO}_g)uOK?K}ft@s+EbGCisG@J2-sWIIixw zkWntN=*0buTTjksf(Ly?FKZbsr92|IU8V-n+3esvxs{;i|z z%n_1Q7tTf%UbzvdE~Zi@U%K_%z(T9n$A{*wqWeHI5+%SW4wR-pPW>BF?kJ7g$U-*R8}lJ8&vS&HmzrSh)3nbBKhCM+{qeXoS{{As+v z5Nb#vTs8WuVqMzuLwSiWX&Qy_eye-8%l{0F?q=*7<40&ML7pceMGQ~zR48;*bZ59JdbsX&PYMZK z-O9BJJFAdfrW;rgcmym-&(hf>pXiD4^=za&2D)Z?N-eAkGci~PNZb`uqhuVaHDb0q zGMR;!(3i_xo%(z2{5to8?aB~Rq?SNUM<~iH`Ow3qll)xV;bXB&s`g(>4B{-giZ zFdjDzu53}kA2O%B$P;5!iVWRTGE6fT#&foFD>u0X_*XQlgO2D2D*ZS|rMRBpUUBP= z6z59$4Fw^q$Tmk+#pg#%erosS6DqW_E&Xk~9ZZgU!cIE9qIO0}-&KwTY9ypPOLUA{ zwD!C3g?S3W6%xr)-aV%!^=T^_MtE#5qlXKdimIVy~P-bP$S{nD)AQWa=n|%8AM}IeIFD>j2ALba|Ai4ep}oRqy)Qk zuf$WXJG&LCRE*?DU%{;Nq}H`>?`mISm^;ReolIDtJt858OxqJ$i4yVBnX zi?O_>kvFs7Sw6U!2JI+6XbHxPk1wwNcZ=0&Y?6ekSqs#&(Z0oCwM-fg-k7Vy0+a>>5K^5~$6TfoKuOZK-3gB|s7$d=%T79i zJrNaE7_^WAnpnf-B7|6>c+C44r&$6DoVrG79FD_v@X)e<8}<_D>5&|*L_3|)QgM79 zdp+D>c{;nLB34?3--qF?-=MXL9*c81UNeK5lT&Nd4#aK|PNj{76&c*9MQK->F&R zNE_b$_W^^&Nwk8jd;k4aP0j!O$|Z^Ze}46y{J*bQ{Nkz&m3;cag(jp=FNB<3-`84se6NvKT!=if<7&9KDwEq7YX(kJE}%_ zny<|}|KuOO9j=&F*ks%vYPeMxbqHQP-mkxjb=S~wZ-Jd&4GkO>U`buOg}UEtxVcrH zf1Y8dD-wti&;Y$P4BZn7N=hctzjLo>cDa15P1<>yOW0zrvIdq^Q_yCN6bj)?3{PNTsYM+d7a~GF) zKGp;#t8_8W0A)!*(oBG=_7C}SV`MM{%<*~D`Tz+A(5sjp&th+84g)~pygBioF6-4$ z8uaJqg2A#4e>@T3pMN`?H-k{q?7UnUKp^L?tGveE6y|coxo~7dQx%E2K*K1G{3t|L zcFYV3uBc(yaQwlU7XtlDE}#@b75aMjP8$x90ujy&NFSEuh?(G+gB(0_tYBIJP|FDT z4p6JGCS~VpUD>%>JS8P13qY`&(3%1ghAz>-4|o=9gRjVjp~LzweQnS%{hFl|6vc&T zu`O$Q1|o3`bq1e)(ZtHIBX5xwBnp&Z;d7IRmK&ckE~S($N@;iLPTv|fGF52727+Tn z%zC=>?519_ixjv7T@U z8}9L=rJYM~8v8IjT41ms4F~fq^uWN88SGQn0X{Lh>#|_11)#%IA};K8v@7-vmG891 z2-Y*b0H6e!dNmR$fze&R+$rR;!8z!s^Ej?sqJAyBH%m`y?5?5TL1M-sQ?mB53SiV> zwehzl{ebEmlCD7mS_Om)rbOK7fao{a3)${`JCtw~`T_M~5+@X{BjeVxG`Yh)GuFOUztsPE=t%a0^0x>T*5UuvGuHqX^UJg3qXs1 zCcyIV>azkPO(>Vtz5O+}v=jh0AMjGa=n3@Et`cSJVw+K6UyW@HrX~ZCkTi%4kpShH z5OkRXf#_HT+Cb)^p&=yo$+h2kYcAMZBeMbui11B`C8>3|%rVFfUH;4t)JtI0Ln_%F z(XKbu!Eg%b7G?a$2nXA7T<8GU;kxkY9q=tLnumCatXJW2IiCTfUX8epPyqcoJ8Md8 zc!W$+HZz*ShoSdt4Gu+Z*w0b--f&%Q#58WN8`+sFrm>9>n(Km64$1QzaSaH9%K`s! zX+ts@H#rd7waQb32N?RNL`)OZ@4_>|Exr6{tG}89y8He}EZLpy&*f3@>rBW_jl{>A9>VIZ^jgPxb83k3npL}0t4n8hy~&%HQt@z=3*50@J5pO zxe3@NkpeabnzQiCmKIOjdXhoehvYv>RDy@utDo6EuW0nJY6bE9r4 z(i@_K!`9aJBYDSi`EmKGvDJ^=)IUJUqY?!d=(Ew(}eefOBzVb^aIh&wG3s^`M`Q{M^`x2NZrPLx+_bTZ>%c zOB{+(Ef7U7ahYIldI?z&@{N4p@An2JQ59^`NK7h(#hWgN6$;+r$NhmS3IcyNe3i$b z0<3eEr`=zDz+3t+Lh>KX>HE9F@ZiPij7AWT*ewiSVw7Nqvjvv@dyF2*si8}RXq#{6 zeOzBUuPFQu$*NB2Gj76p!X*5B*&i^jhF6!J5nseOFbMk^MU%k*F*Tf~6_CeVe$q6nFh!ulC+Xov1z~VqmgUh+H^H>y< zz<%BGAys*gv2Hl1!Y6~}*Zz!wJpnY>=+#qp6rzVTi=4FF=s;KGkE~32^L*)*pu~&; z?H1a0LEVpN$C{WR$>kN`uG^vz0?Wiw3)~gFFQ+j&9k2pOBLPx3v?IBFB2%VRJK77!CQonlx} zB*~{%_;h`j^gj7_5JC3G(OqA@2Np-9;QIHVRKEHdXo6KuQ8$^{*rde0=sCfij~p^r zQJ9@}kndNup}Ytz6`8rcYQ=~s2(W2yF0H(`$PQBK6To>-h5xk|5CVo;Krn-e*-=Kv zAy#j@j&!)ee3W3kL4Jh>oUR*$F4drvi}`m)dd(}*=`)7{Fto1SkF#J;0QwXhN2#H3 zgg*%tTNManKyav=2?+FBI6M{`tl;=W09B`DvQt-NW{tt_oB0=trH|18Nd2HE4mWVY?49DFe6z%|K&< zF8TC)Og@Ok)1Unkx7dFVgp93Gr-zR7v_Nfhmirs1;zR5Xb~J(C6uC7VfG~v^mgxKb z0(+jzZGSdpsYWiqp86BiZi4be50;rZ;%2?z%oGwAzQF`M+pB;BCJhG@5hyo7eiK5T z^A5C>q^D$)jySzwRwEg-t0t@&11K3{seVa zc$&9}gxN0w%DNWba10zjNJJ(WaA0A2C^%iP=fMyrijZo!dwO1Z+^&$JFT3fg_H@G2 zpAhQ{@T*;PL&xbWk(c=<;twDKvMkjxJA|%-LT~y%n;W8-s=+2!ECv+W3m~b@7_K`9 z_AwALegG0w3Emqo2JquA$3@O^;_ni~;t}gNH8qv6n+)01*2ijA2AsJE9R2_v6hs!- zGt~rfbA!@6bJ+YF#5&rbyi&`ZLh+6liHUHI@1&XZ2yGa)dX33 z@SGqc(*jTusv-PAOA!;jQDex(vFdlVzx|;FB>^V4VbSe1F9HKItQ_F(-X!QH!q?F9 zz$Em_QyD6WaFT7<>>Ufr#>am|FEzNq-GsLFw2x>xLx8N`kQ5KM*#h80C;PI!^Wctv zlN*rIuqe&}D=r8H(E#*(z~!w1YZU0_GBO@pG!C$*BM*udT3{6kgOc^O;0O*Os5OG* z>;hzp40r8ZUFRg1Dt=n*(*sj~y5)r8L{~=qWy97g{EM&bfXPSu#0~=;K0dOBU{)s% z@g+OO&1a(@~fg@i6oPeZCfRQmEN>qbnp9R(hv%^co-vnb8H(2Kpcn_Gc_racp zBvHPgGoup$H&Ze4I0>U$=n_cL0>L0Q&e@(UQ(p&7C!}{b-BkpFcHWmU6ktvgJSLJG z0SlrU_>in%lxePw!JLjRi%QZFZ5@6g>I5h1MD+xi1%gz&YThIf$Xbrj_5?M*?iaJs zULw8_5!3*Qmkm&-`gaNE^oym$PN2HPJ$!2TI0XcYwQ%4q%4taigLu@h9BxGlkz8Ecs`_sc>ya9& zKEHS{)Papo6QOYO=fD3ag@<*ha}<4e1w-l|u&s^2iiIal&0lzjNDkJs{hSc0HI>v< z`?1ttphy6XsVtL&xe0M7g9OP-0d$G7Hu7Q-1WZPld$4E*bj6z;GCUp#AF?}4Pc$=0 zgY(5cZhikt$-2!amkH8BAW5{sV<4ExL%kO&t0#zsu8vn~^eVx$v z4(}BYY0E^Hyr-COHJ55i7-<8dKyP2frxtF5M9#ii0Zi%0CNk?WHZEVKT>L3eiBP$o z)0%>Z&^8dlh^fXq&>RB1cCg`GQmM+)KnB#a0D(ZaWU&J1I3EbJa={aa97w=fqd&o= z+2njLLEUK|3FXDM>DVo8q+`aQ$~dN~9rusUrAf)85P_(y`!>VjX~@V?ARQU9FLp~U zAIOF&i7aY8Q74MzP7LiesFP{0bSu;^6r;XYH6gXvq;y_+g86kIK4tL78QVt#{o+I8>_>g@Qo?3J&&snw3)MXO1ti* zp7&SaQBIdl+9f55V7Q*pubUo*hVs!VjGw~_u=KM6H0UE(p-9p3 z3GPnpmEl!5B$qle0}}MCLG)OIuJEq>t@SDUvCDi@lA9&_#sZFsI0Cc9Ri1hoNSakh zbdF44K+aUMvLdG_9MI~mS3k$*kglZd!J&cO2TNJ3nMZpA$2|q z1Rx^N|A(h>;78Wedj*WArDwt-Vdt85h1-onMBO9g(r0Uw7zL3YybsPJ-j`qB`*<_> zC?k;~o-*5$mx*Wvwzf0W1O|4s&lF3q7rb3Mm3^OVwJw{vhYkD13@H7zqVT_3Wp0I_ zRp<~|c@Ap#?x&Pymtp^gm>y~%G8MG{a1>l#nc3KM!0&~p;C=HeUuCBfA#@#bm2ZCr z+h>7{B;QNb5{CM%7IwiIXVyj!bBk1FpC9Mh1gSWE+WL;aR+|6WpPg*SD<@+aj?O29Y>y*Riv-a8%WaRD^Pyef14$uEeEq;h8Abbh z6bd5n3?)e{9p1-8lGVPvoMR0|gJ7B@Ujx<+D|D3Xp>IyG|L7{3p6yE#u1M;Ne~Yi} zyCoaj8{57$PN~mPQIJ}%c#TTMPWD~8y8h$mX@9f~5&95ZE2sv5LKU!>#|3r~g5y*U zZ+X!R6StFLjK|iA>kr`|7`%?W&&XpW`&~KX*;P@v5V4mGYn=ei9HoC1r0p>2q3MPW z#+>$DI2mQn&TKlJe9Cpelzs*p!neM^KJV@?_qyusi1ts5BE3M8^uM~dK2JSliV2GM z;CZZpb=J<=@jmM_6S}KtqE3o@06!-t2-z?0W0kx17<)~ko;9*TQBB<~L6bO`A=HiA zT}%zT)zy;$v$U4u zP}|Iqc!FW;jvt4Y($P}CMaPAcU+XB^irubKNL4H2 zO9RLh^&-+G+l2RvR1Coq67Di;g9c5|B=B!FTYmF1N7B|U%?j>mdh zZ8IYWQM?R~8n(D2mpR}JhN0knNg0=AzG-^;&lOzp4WZ4&7Ni14Q`xkgRFQ{h_hS_> zc|#tNhsJq8Zk{;s#xa3K0G+7FEsJGd`@({{i$AM#?lGN;Fmy@0TXd%;kTY>Zm=Jr@u-4wbo#C6~`b7MC#g)XugUHf?P@R~A566V? z2c$9uV&P!2K^1pxYgM2R!AAi{N@gP2kkY8qwSx_i`vFqoQz+M-lsK@9+EXWY3tK^M zf)Gm8q5P>d`_kKCTn{JI8W7;2_RS{%l?8zX^P==I+k=P;_(~}?jqhnUz7U}0eH({T zZt$HZ14km%YMRW1{1O_YLvADlN~=8+IN+@eNioN({YQP_OqyVp1LZw1rP?vlA(!>` z=D_yTt`BthZ@PTf;2?bm2PiYTLVMSjeu>V>zE* zo@j9!O}lmN3e$`j5)<@Skb4X^acSVe$+p=ePH<2c#LHxriq~*v6sZNv zAtoldP~tKGd>?vhJsWV#d&4O^Wf9mXT!;+c(2|LT*-Q57Eg@yOrg%_Zv=?8U0 z3AlNzoNp9Iw3t+%ZJX=; z*K*+E{1N3Bu;IoKo^?RV=iKd>s_}zL*Y(FCA3AnPL)3r)1eGi@Yf9kRz6`~U&6kb8y0cD2YcvGfKqww`$s9rfbCg_EE z{)D3Lx=l4&loK?SIC@Vg;SQFAjVSK11*#5mb0WNH-NCSZQA*u(A`WVWe;1@#VZ@pV zQ^YkJ6W-nNmU=}TT}l$&MH=0d-s-Kh)JvNgurcIXO$D|lskeCG2;U$OO#*&PqnTm` zG;@>L(VQ0T(usr8Q^thBHkbplVzYbhNgb4$PJ9YsafX^y-mc7UE)j5n>hJZ0F2JKa za`vc}=-cArldAD;$HSnK8_d=$w`5H`?aqD+Kl!7^!1I~{EXLKBlvQ@_FUn2~ZAZGYKWKy%UlWq6l_-36U zj``Vt##KgV@u^;uCKnVAnPmK2IC>AbLeNjRtgKtk_$vO~uX5oZ9G@w7pAr6ZVg1I{ zfc=F1pzEsO@4f>fT?$pgoPlHXff6Od4#GwUyI{2pyO1YT;HT)6+dRaaot?40_?hP9 zz7VLlNohJtcxG%sKSPJmgx2}gtq^yff71bk*lAZ#pTyk^WlS0 zO0+046|`JfUOsPGBlWZ(=0|j3O29(k55IF2O236{wh#I*PTx3joQ^fKSLv;XRPOsA zJ0*pV*AQ?0nWrF?r^&pm@wwj0)`1O{Yj`UckvJBnp|S63G)$+H1il)0VzGJ>R{|6V z7FLS3v2!w%GgUp~yGL;iMaZM$aA^$flR_p}U<@I&6dw}PC?MFh90=N|)V87NV88XS z&Q>Egx5Kw;oU(rk|5cVdeswDU{B7o~k1JkZ8}r3#z`jp>e2uWh&*p$?X*9dSUWIU` zXgA%>2;Z5EW~N}cR_wgl;XKjBz-GG+ChVoewzN1%P^;mfzCG^0ALT=!96+Y^%V4_2 zKVUY@jW8YmB`!lq=#Vg6I(7DJmVlc^O}xEO7jcYHyVg%LKEbF(poher@N}fD4ug6? zqJDUP*z1trG4}gl3d4IitI+ti;tB$@1eAflP_p4A+z=li033TC71Umk>;?4sO?Y`? zV;!nm)*X&GtxHcu$;=^}h;ig>)9{>T-*P1mTs7N@v5n+Y0~?1HHd%DA_nrGWlF_p8}+R{EVJ2Mt@3t3iKk< zRKl=7fAIDOv$<6I{No?yN&zn~%7Xg-=t6M?)lfIHx}zlOk6dp*XDJm5A;na`DluLL z>VmPD-Ql`*HBgqFcKrg{;`+W1(1vY~+WjC?GaC+A45IiVQ3Jr^{b9G4j_k#z@wwcB zq9zN3wLTE8Xf--?L)+aX&JNn1YrwjV0k7uzp?%X+u&vwgCyQz+Bk15?%K>h$HR`xL z#V#X-B6(DJjm%FR;6`F3#&%$Lff?1w2YmQ*8~dsl;IO;?4$Yz|DE|a?YnZr~5+8!_ zTd3)ej41z9 z0B~b2ElrgEM{>c~dWiEEm)i{m8h6O&NfJx8Y})x(>%R|O#IJsYBgvpAD;YSd+(>;z zA8J3M@mk(6aoY7}TPu%H8w(KvE=6d;Y%=XJh>!3FeZY&RiAx+XzXMI;fF5Z8kZfTP zhMN02T@>wy696Zey-Khy%n%HD|1ArGy($D*N5w4XMqJfNbg|w*HUkNSIgHRm)OL|p zbD=gyA~b^R54D0KE_qvaJ?r;S4VdK_q2J78DFtQA)f)hXV1q;14;cC|LX7=x##Lo( zIy;@9Kn=yymnaUc&-5=Lr)qeK3DTG=O2ve zK8)=RyL2hx=^1(w2CJ`lm|r#=6QH6cu&_*IK3_38L`n)9>0aV|LHD7%uU`Or8h9~X zLr|6Tg@SW6%yNzj-M&T(?>JiD&>0Fs&Cz$r^c#0$25}cl#SeFQDTK%c^+c%l6Xytq zZA6*~_x%ixtqZD|ufjuKtirsz5aOe=w&ucYmi91>4JC50&19q{f;zZM2b!R+a@L=+ z3{>lN+DvRF|3Gy}i+8t?yLT}JS8qiC0qDbQNT0_Zs!qoGY=^3ELnF^LC27fUWbb{24cXu&8 zAhbDA;(&Ow5b4NLrDZ{Nu?kHqg&YbtqGfEXAGJc1U$;tF6RQy=huU2?dDM6qYC*-( zgVU@JElVi`Eudt>IAO_l%i*a>Bmd=FyPredgr?nBvuvRtDOTSMA|U12y};7og{)83 zv5%-Vt=|x4z=oSfZ73Ix>*M~ysCS0KRg)_zrP!!C^3I!JpaEfXY)}*PX-vEvb3-BI zwuH`yC-d34!rReKJT)HQrJZDrlZtM2TsZflr=B_OJ=(TLk|0EBKFi(HSVoRYoFdzQ zEl?7+wZ0D-nn7Gg6Q#6#3L5B_0k-5OKS^cMdDFv{JC%8huCLBc=-*9+UHjQ)j zp@)!IeEPC!?zTdfoAfZ#nfZ(H^LR3X^0^xmNAu?{unj5=$X~j233`;!WU4=?qXpZE z4>ZN_jc@7r*q*r_Ep~#F2$#kv#xjMX>#xRLiXg_iKu%7hx%Hazmh@t?!q4C*)%X4? zB;WsdOFW)&Hw-L^X1RSnxBmK<%~TWtJlG_5d9a+0;4w7lb>!(d`v(owbdy8Od}wqj z98~Lr&OSCC2SQmT)9bq!rcn1=hs9N{Jvyt#3D8Zt&~QNfR$|rZnVA~=%M1)X*p%y6KNzyLp#``=2VyQ$qFA^sY<-ob#Xsak3 zO~2-}|RLA$a?C2m~+#YgrXw}C9US-Qt12_ag* z*=(6!2wPDtoEv(Oov&X%PdIUGKt`xKoxjbj*ZRBP?*^NQZPMdKw1>v3ZK9>KJmmN& zvVYIV>`pb9uP^u0s`QALiFQgMG!dZJC}>#|DOyCcD+vj2FvS=Qh2nzYb11`y_KP}a zWdWLfhMPMH26SfFx89J_8M3*`d5R04RgjNsb7s#xLU!F84ax=Bp#)T0D;gUc@!`lW zvDml_>0v0z>DL;h&I1@<-!hI`6;jk;u%T)Le--8a9m)?b1|E(02z$4K4)o83g=U+tRF;voKV#dfd7S- zN@jwS9LS_IwlyzVzRbkN0Xurq3u}PNDdw?e;r7-Bn(#s{xQn{N1GdU$$@+tL4@CJ{ zD9Ar-t&4{fO9JwrrS^HK%G_9o9+6(tryH0j)k?U|Ha%i|{7J!CS3y*PED~u`h?k?Y z*oR9*+7E_sDE2S{pTrk607$~BK?k$M7m6>2$33*uLYC*{kB@}Vcs1p9IOx0i$_ z_fG+Xtk(!9tnfIZemFhI2#dlmeuII`Wt#hneK6gMP&u@?m^e6O`W;ua0`a922`p=d zc3MDM0@xjB=Xig1!`MDgl0fjmn~NGNZZ1XGjnWW6@d+%88wcdzbh@It$Lto`@^D^h zFp3tH&j9hEjsPG^`%d?O)DNC2N$nDypzy|YhCVP=gKsX?eS^LZXecvWX5u8J;*(KBbog~S-PG;OB!BB`eW;i72C1v4~f}5nB-&bs&QE?$k2M7 zH_$8%RUqK(T!yp29|LA>4AAkKfd~hamiEe53*4Fe3UDB#?}DLdcqncmif1Pow<%mX zq5YYO&2X%uTYuJm>>q5+R9BQF3jgUYyHh69}Tf3 zr}+3J|1Gj7ec8*FfdvW(?ZpC9g~zqc~4bTH)={C+XIDK>LIe#YkSrt+BN zOeD#-y5Hqzz>QzyVQ}b-eA{tnJn zsGnh7Z;`XJn_5cDZhvwf4Sh??_uL6)ac?49HR#xPE&Y_9Z|47Y=d}i~sD*Pj_Zobh zkLl;nm;AXAWf+kz_3(H<_m55G5-3)$Uvv_hf28zisQE(s@>b=2Zb^Eh@+bFcvPHqp zBbAUig&IUOKeeRpKa82Rcu0lVE)a_&h?C`bQwgYH(nO)r0ot}#hHn$~MbI4#>mvHp zgof7QkBff-6>9G3m!Cfx-rN{nE%B%Q*E{dI&61yf!%nsyZv&KhxaMVI$y9?krnqLF z-l-w_mnQulq7bNNk-R>9cGs80TQ9|!=JS(s8YQPLgf_l#yS#o;=JWA-Pjh3yqBTeP zd3ljx7iVWxBIvAM`CD>d2(OFD5_`q#U!C-uJ5w-BDV zYfiGX8JpIgj@Wkkd+fq_LB&#Ep@!8mC2`IVfln;7gt+GoKkB{-JdP^2Xr2yCNkyPV zB%ay<$zI=|aQ)_Md8k&Px;7frN%Q3#-xQ0=!>6P$3Cnlsvi)Tk{sXhH+)df7tppzn z1(*kEJblGnvz%q@SsCs#GO8^Nxpl1Vy)W*80|MEIQ3Hh+U0|Rz=RA7^(iH|H?8E6c zDai|iKoD*`kR?D@Ourn)t9-6Bcq1%T`gAvIpMSn;DNp7TcWpsM+OGX##O>xXeW6V- z13gOIczCU+=B9&&TlHIfh@YtSMU}=o`GH;%%`!rsCRZbT-VBm$gsD{m-;WtpYEd6~ zWAiOSa`=}gL!TvnStZ_qR)x@4nOe8428MY%}*eIlxjbsdFey`tj%j4 z+5B0hZ*|NhA>uW}wsR50z{T#X#5J2tCo+4P4>IjdLLyc3f3pQH&D?*yG2c3!VDNz{ zKd9S)Yl}AWiN(f>sI`3#r89b4qrzT`XzxcE{UqCQZRRXM)(Sh z^CM{HVsGy`wsGq6w5dLZIxvdv4LZ}J2>OxGk_ye%;Wn(+bEjagQ(wL-{2d)C&pjas zz_MGM%QU9B*EwLw@&$U^1&)qrC_UeEWa)sD=efoH=XZy+t@q0lvjL}wPrXD1tuT#N z#2qd`!5waT7+7_F&~1{0Xgb5{&Lt~Ro%@jdR%Z=LE}4TGY4TE>SUge)pntQ&=$(E7 zth~H2Ilx86z=ekPI;t?$0H z*jn-R({SfuQacw8G#C@re?j(*U}rGbH(I|L#yQ;O{>4e`y*mxmR=GtWaA7{tU(s5^*Fo`Cm^Nf}*?&5%r0 z1dTzSn}GR10J=3tC#Pd6%s)v8ZQb+F5M*3>HC!F5)vrb!T&PxrhcQ|(78*^Y;{Jh; zQUXT;CVkpL8rQ=Y%mn!W=pms$@Pue)1p@ORD7jBE2cw3EQ~(>I1E0oZxGwwZB82au zI0(8`-k{P5VbfFwi3B1}=N&4*Mw}v)u^9*U38~3pkgXSzFv9zU5kjM&(t=}1c5D-% zxG)kHsrz>96*^}P+x0)Vy}zWb#l z7Cz|OJb+*ZsGLbb8btA*AW#CsB`ku&Xs){l=pRhOQ`bdGa&O3$~*MHkR$U0q*)w?m=c8Iz7X zT@0E-klsVAY6lB#@yLa%DM&j7W0n%O?_I&_D>yR|?5dLfL{d@*Mcz-KpXWw1c4=NP zD#(_vKsn++dZvHbx>voS{sL3l_~=!KlwgDfl&ec1a2SD=>W4HA5EARaA%2w`yJ`n0 z0dI;v7K(_E}Gen?f zO=N7EtCIPds7T{VYr7$2+UB{MaqoVd?+ju;DF|C`1xYw4e~{|!7e+@fK50EzybJY# zSy@@7WMnQYdr%`04DyS7o5`ys2|vfkhyc~cVJaJV&rYs@mxcKGvlu!rp(G$n#jhbP z{l2Y*wbKn=!Eux~5*Vad79d^6|CdpG9Bh=f4-FWOhh*ZpI28 z2dFgkxLb~n1#Qyf?DyB+!5w5kJZbRZ!v~dvtC^{evICnlFfRw^;tn=-ke!`A^oG79 zLJYWkUuSIHe2})ssOuMh;rvm@se1!Zt-+n=LSLB6v-3H1>{tJ=g5*^|KmaP!zBDhw z(Ey&r9~;?4n@@#dz!Io_i_5$R1OCN0<Q3(Xn8Thtv48R$?Zmao3aVVW> zq+sIi_kQurwatZ%9?LvI)h{f(UkC3fFGL)5%BP>w?517qCkEaL-84GnQ2G1mg4V@v z9aA%xmG?!MPTkZ$^NKpx(rbyHLq1@E_T_A4VfK1u{UNQb=NbJov}A95p6xTt$EW6Z z)7mwJKC*vrZY19!aMVuGFn5h+ZtC~8RmiLL7Q&lICiXFW(v{hwg^U)p;lSB3xe8N5 z#WCl)sKBOAm*tnV8heb45)V3iy!-MP!24+5T7oWZ&r-v+*^lI|wFndmA}yF5FB<|O z6`UU~T(F=@i{nG?WG7ho-5C*;^E0w{B^;3PRQXAEzd2$929o%@`~b#)!X=-xvt7sf z8Alf4m}>;OVq;`Kuw5JGV|-vqyw!EofNkr6@5AVne9yNN?%nHRA4uMu6cq2JW>nRU z=_nWhBo{Bxm>YFrI_~W!4k$7wvWF2k32!ku%}~EW|P!qD-zIztNwY zj?T7Z<{XU*4IagA4>AVIoV!Q5e4;5k00`1lAf?uxc`G&BTAAapy7;h>N=0rT7JsN<|Smq`B7>`jrr>CEf! z-KX>D9p(IlRF^o(w%dx!&9%INVTW7VR3;R1qT`o&KNy?b?2X&EZ(|LdlDiH_z%at?Odu0kEhY&Ek^LiNd@zM? z=S?ypMUzz3VIWG8KPW4ri+1&7U+wGtBi}4WHY0_U`SPCz9x6y)e<#HJb&Pf7PK5T5 z%-81SP`z8G{_HHAs!!k7Sau6GvNw{=++FiMqWtw^+4DJ~y=>HOLY_BXF@o70S?!t;h>c?6k`MG(=)V(Q7A+!}j8qRivj#%*kjzz;i zz7Bjxtb%pOI(`IQ$T`|7Z}2h1hU2c>ZwC5J|2rd>Oqd%kZag#5ljl;f`Y4)ur_m!Q zBd%~@>v6-G{XvIG^$i|pNKs6%ymkTd?m#7IzROK}j4!aa=JlGvb-pG;O z8TfJutPlVpEl#u2exjKFC{5T)EHhCs@%oRRl?#k1s(X0_6dOh=*xqs~tj{=&e*7vW z8LQkaB--t&P5v&TNV!6E!N6jq?aZ%Gr$UtoW<56T--?ztQq)mZSF;ziJEL9Wc$7mY zKU$<{(DZy({)>MTrV!W8TtoQ!d3SwRcuIOkTzl<=1?k8P_g#&S$X8aIhyD4B)G9Lf zG|teTZV9S#HR$MFKRi-eJoYD{-X_`PQTW2%lsgXkQdKfcZoaC5cqgVh&V^s;%D(v6 zm~u|GL?e|A?^hy`4pwF3EN>3|x;C)pS-4hjItjs>U*)e$%16FKa-S^zJ949U4D7Ok z_7}Ei_uzCMLdDDMR~VaW|5F;Ni4cY619uFw9-c|O8@bID>7NoaF*I6!g3mFD%<@|5(23{qy|${U3*0sEP`tB8)~$&U7T^UREG- z;`7)?7bu$a1lWW+V_xv4Ycg9lQXb}-+PnWT*nTv?ibEt47vae zxyLN5k9z3o9HV8o+QpTh)_VWabXS~_SE(j!MR3Dty%N3f;z7hNhcis&>C zZ+0lB{w8If^(SFBdb7MPC|qMjwcOK4=ovnETh6AY;DMJmoB4$?LVrQSIt8I>?b5q^ z!%^C%A`p?Yv9n7%ua=!ztmAF`$R<_*>Jb&jd1xo738zEcu>{}yMdJqMuF2D-eTAPN z9dG^7Dl~UsQZAMD)X$Neo@uf+}d>odnsIK&acEet)T?IR)-k4Vw{rPPu(nVnZ6BL3Umr-59wKScZ zk@w!n=N=B*Drf6aN{X2=<(%u}3i8yaY+Nz37^u7I>wbNmNhp5qn5HMzwio4XNA>Tw9Q+#;f5kr+rEVcWIJ@Kn)m)` zS5DxqbzGu5`7PJ~D?vfet@KiDs#1778{R2qyK+*!+ zp+ZAyeTz;G=#4D6dwBFM3QuG|Y zFgCG2(`HOKd|{u+s;Q)AqJ4)-t}LHJnAEyK=(}vy1j1C_-W17=`$EK3$#*jaMR$)5 zJ?VGMzNhDv#r{~mP>55wEUAIoizH}d+)_W6XaAF7&rj!-gTya9-720H7%R2RJo+H; z{y>-^yVj@S$hL&Fnp3=Uyn}u#y1`k~i-fD}KYDY?(;80{&h2A&SVw|GP|HssZ@KPI z__#kzo&KCk1~tRvYe4tDDIvo>Xni)y>^yIuJ-~N!YtZ@O<+2f*RPN<7PdCd?|8SFj zx)pu9%W37NXYE+kkWH-q#(UwXqb|p0Ro8fv9_3weD;nhE9i5$1O(vzQol`9^eUoRk zDz7@W#+w(xF4!KKlUKa$%RjfSQM+kkk@D!?qm_B#GZ~Rjt&|6=wk%ht_6*!_J`v4* z#z=Tfe>)5E zW42Yl8@cSOx0fqNn@nCg$ZLf5-0wG(+p~WHEcQ!dqoeEmCcWd%Q_0zXp^rP{+70f8 z-(aX&IV0-Ss|oqe#nb%zoDcmSp@c9#ZPh^}ATW>^8+*H}s|#jegwW6opl(lMM;oZ7 zsm`1M$2d+0d3fO72yous7*JVlZEe-=0X@>}^*bFOH zeYy{ng&0Vd_1Cs)%!7pawFRzlJVTyPT<+n&ar_Ts1eo0F>Ro3qZTP*D=7GwYR*n3@J%Tg@+G66Fjx(=;+#I z;&nPHkA#~PZCWE^ZYh?0;9e~NMSdJ?Y#o4a{t9A6CA#ORwoY~8gb}p7RmKrJ0ek!h zl&s)hQEQr?(6k3df>3N+T*zeSJY*jAB;keYZK)cLiLj~eRDR5~wCzTyeuK*v;-ycJ zH|r6j2at-tU}n%G83f+QC6=}Wd{5~yN-fZTeH9v8kpR(tOpI2YTiXBFFt^V{c%h0B z-M`ZybAabQI}vgN#`(lTBL)T;OX}-dA{#^7X<=but?KG(^hojDD6PZ2;ppTgeEo`t zG07QJB7OE#$?)K-P~d5!bc9~Tub(CkFn(;O0Ddyi8D_b**Tp-7j-eY+`ZM`|God}d8eP2Pi4`0g}!K3^KivV)-0-y9xZ z-a8Ii3Uj$I59*OoT+5i~wjESDar`^Hn$j64;I{*Y{wv5K$R|?4$-qoSMP&ePa+Pt* z4lNs0#4%&UUcQ(b&4aMIlk4wKd2jZ@3Q$+nqgtRgliW0s5xJR!Ru2CTQ^NRoenv0Q zrvYJpj#E3o6JIt4GgLFg;sLXs7~cZb6g29p_z6}^!reo1LdacOpd;fS5@JX!JCXmY zAC@$@jX(Wk13W2~{dgE|L|;tif$GBP&CtE&go+YOV$nm`vKdS@Jhcpc~$9=w)^xkmA*dICDw zV4o6HWoBbz`wBy#6HVbZKH0Z(BYkd&5Ke4vRs>jk7fGZ^!IBCuPa5>9)DMu+x2_bf z2q)f0kKQRmUPSW^9@jgpk4JlbeNeXFXn*T<$c>r2Dx*P4bkFfKT#3$|0T-u!!pBN0 zWl8NYs&~LPi3tN}02>+_ri;aMJ5InXX&ml5^3s86{vr(b`Z{C15-+-0O%nO?L*-3y zDaxar1HKTL8h}jY7gexJG57|dyOV?EOTG^U2M51<|2|_9s!r*FKlj~?e?F62N!*2V z`LaVIiY|phSMvU!!2D{0X?=GR*K99Z!n_BbJ8;{4*}*bIi|gsdwn+$yi1d?$?|)ti zu(^wZI|~{w0H#hfKpb5`c(*4Lu}cPTSm*E-4Z88+PZkEzfdAvd`QP7Sp9=o269Ejc yKmY$>*k$;?eL-?2Y|9Q6t)?TPb2XFaHm*5hc9< literal 0 HcmV?d00001 diff --git a/inst/tutorials/18-explaining-models-and-predictions/images/pic4.png b/inst/tutorials/18-explaining-models-and-predictions/images/pic4.png new file mode 100644 index 0000000000000000000000000000000000000000..9ca4cbb56d23be06a3dff5d2a743def5f308e7ad GIT binary patch literal 44191 zcmd43cRZH=-#%Wp?42zk6|U^;oh_oWw~)O@wj_IIg(Q(esEEvDWsgv1vSsi6d!F9) zx$p0NfA0JD{p0t?&!h7pm+LxR=Xt))=W#rb<9J?S>T2=?=V;EIIdg_UQ9<_BnKS69 zGiT7)aj@VKW21gi_;%Limb~%F2nUWa1LlaE+8P`!k$K}i!!UkkJ z+wAbl{LGmGK1Eq6Ele?Oi%ZTGOmdGmUvIL}laM4bpHt8X-(DUIlEjspe3>owLF>JbkQ%^n4XD34Fz|Uh}+g`a5OgRcTq|E2(ZGl!@zft?6=Rnutfy?~#hWlv05WXTOK( z`HVleh46Uy7t!8e?J?`g;jBcIkhz;r?vI;Vnfb7%lPQUly%?YU`Mjp|kBx(d|Km9= z?!+tU#KYtp@G7|k8zXGbQv7n4$Ex)xQHHiEIyXPu|CS>ia;_)F8pA$jTBeGEc zWWuFk<&Bw+D4_vZ0Jd=LF?nDIUnUy;&Q}fHw8cajaqSr%$MNNJ4+{1*`CgGII+kjF z5Ob)tPJX4}7k8oEQu#~O#Q}W7$uo=p^Wrj&n6PL|;&h(xWi`8EpDygCM9Hbk62mAV zFypy0)A7`Kae&k8Yi)OY^L$@k)aBDWz_$j2{-``ryt5^7%czJr*q4vpCYl3n#ols=8Crw#cUH-j}w0L2+ z`!U0^v3xEwDy^AfpX?8YO3c=Kl~Jv67vNW#=wrzPabZy+!KdSuH07Yx`cM+D$#WT zg;=J*;VvOD+dNLRZlZJtxys zyCx;+x(k+rv57VrelKs#5rz^mCM^w@w+(O6Dt(p>+uU1v<16A9_wG{k;_g)kt+?4B z)7h6xI~%h~froq3jZ{Xi4{W)GCOoi~i{7+6dL^nEmn4h({PpcO3+}(tUhaEY|9GE| zfBu@J^Yqu3QuuyaUK=w{el~>KOjbz+V^!)Wa~XU_dki=A?O;+#ra%bduJxg%5Z}FJ7WE~ts zHBej`t9GLn{j&J&&80%U@&T{wH+=XD5(Xt-ka;v$bCLbE zR(||ieoHjHNRCV>VN;@&BfrUK41%iPSb_%R&v<`|T7FGzO@U<;PU~57a(uATq;Xo?j<~e%k zfiHuoru3OYSzz7WdT*tXZ&+P96F%{f*~zfd)!KlNe*V4P@E!CsQ!Pv>AHBC;V_;(| zhn%DM97Kg7txc76o_e8U!gTj%DC1}06{+`O!WY?_LZZ_|xr3=3%R6ZJ?_0^o;#|@1 zNad9$`=*_%@#2Q=+W5!-EJyy5jB%1txa|!ig5)q9oE#5Z#H0x+f>;M9reW>s{_cEl z`<(|$Knxc5olr@VS+2M>ENm(J!6E}UI^rqjtc#0vdTc&#cMB7ICkz`q@s}{=a(hxu zv=;rF1U(5~yc>|5*;m;Tog z(p;J12=A>1W#7SJC+5pa`S$h6)#>e}VUv1gC_4PJSj3VOZL(;`KR(#>mRcxh#Gvry zT9_BZ`tc3bG1^82;@W~olJ_=dZQ|I5%IuzE>9eDSMii@M2v^df@tM!or*NC`smqXD zBM)tGl~s?)v+T-j(z06l*z#Ha4x_W%NQn#4!K;h?C1&#U*yOzUiGtWu^xMS_H-DRq z`wcbJ92JN9b`3T7jg+W__+pT7>b~#(B7_zl&#Ju88iQk>^U5ZO?)>2y4gGVA+!ubx z*TH>2QHWtw<>_?!PC*J5(-0vV8wO=xt}5>_vvX!ym@$jT@<^#^<2eJ=*vBlKlsy4- zDy$$HTmPS*Ln`qXCXI#2EjR8!&EzBI4dt=;+7im>H^=RG$}CFHwPBzXrpg`04Y7zA z3N*OFoj%wMcJB6zkw1|x;hg%+#<;*|s&30z+N01*#`0l%Q?42dIkX8>ib-K=m!KsZUR}*_Np36YkAo`T| zh`-aypz@cNwH_0R$1)#+Y||TaofRYH$c>X1MKx}3*X*Y^uN+*O5Dn#4Sz&H zOQZR3p<4wTMSk#`xT^RA_bKxHI~J!s8v_5(Xcnu6G-cfkmq$Nc@>m(;&t+%JvR7K4 zYK^*l0&o1l1ldA-OEE>TQBVM%plWudo1tjo_tyA6FbgjT0Olb_Ue%r{ria`u(j#%riF0 z*Uig}ZccpL6q$&%HEy;l9XHAQ4QNO#=QYpgl1=}-wke7cHSSZ}lw#&!8O@jwm?4cG z#`E@eyt~-JoTtkC$ecmG-Y0=zs&MjW`P*ip6Co7aVW$`C-*R8l<{OdcFNk<7^W`E> zdfY;Wg(C6XoQvb8bVJxlQx(;d+JDxw2o{P^Un>weRc@7S(p%kZslaI)>K~095}1J> zv%G0N^05S;UYO6;faHiENeYjs_4Q7Xm6jrdPkaIO-a$b@BgX{W z7M~yD#&hWK5M;vRxx;hgwY6BH5=WZ}(J#LDi2Lqab(i`cxR-B~j5{um2Budik1?ymu)YQol}wfR##l|_-%?22d=`Hy!V zZ&h@wM&QEEs%6GL9~D{j%)e`taA#D!cP(XIW1}gaQ~93P{LAD>q2s`ryTFk+!bn+p zW;{_AUlVV=HEiE@kf~{?rc!0yNWIUf;g!p5$8TI05HK&AQXhebfx^+sRm*tYhrS^=W10B+-T*c1EjE!MFdR7| z;G&%BeQ!UiJKTlM!hDX3ivy@oa+k!3{?6Gx_*Uf?ZTw}_hfG{v((H5a%)2h}cXF$y zhMgb3$BRvfG#Ve@W4F(ecy&=e`n+aO=t_Uz3VGN>?aFv^*Q~!~dx;e=S+qF=0r zUbl5!ap_|&SL+HUoCtNI48!*{U6*SC7>QCIl8Bu)EYqps6PT#sxI6e5_=fsSo~hTJ zvLmT^Z{+3Od{!jY@M)#yOjj!bcz>D?17CbZ@L*?|U;MQAyfImoE_);x$bQd~koR8u zwf}hZ^jMPWgi+>;!YH5%-#VpKgMj%FHvMVgd}r&@WU$xyC|~cSHZDDO=wLeJ|H(fdo)U_+{D{ zPOW)d|4(~J6iii$2~TbL=c#x)WWfLwtELj}IEHW}rxo?z$q55q7Y4kZ2Q&$z1~&I* zpS2ww>_p|~iFvL{#r}>zF|Q=ya`g~ zu9n(cIoD<$hRPH9y}9FZay;(5xbH@Pl6Ud>vF%qaVTQP2K?kKyy6;FY#6L6i_r2j8 zwosn0QfD$-HC4qiyfRpHm7lh<%dXDjexvO2^XdoYTF*}Ab{F~YD<*8;Tt;Q8&>w}3 zRQbf!;g!g&eir_p<&Ys}&+nxc5&D&`ttsKONL`kTpltos91|rp_Q`7_ccjv- zEoGgt005!7i5#isaUZ_JYbxDr(y>v&SOnqD@1DK6Qy9OsI7q8`yf)W!QK#5A@b_5t za0;0O>&;C4*LMnO1QI#*26jQ{ndGgq#U~_8il9Q>$Gpc}ilvN+vRXP*!2u5p&|%I# z>W$SNe{Y@Ovoq@9{PQ!WSy4-dh=)0JA^U>Zgml+t!a0m;^gEwPpg;pi0D`vQ%;qAZ zoWv0a<@LOanBKd4Q8VcypFD2niP@1wGl*RQM0;ZJ$$kF#nTUrPA%iG8+_=fmuFUg* z$TDbAOhm*e-tQ%7KN1TtX0xcH?IG)Ta^!&sD+PwtKT^p2pYul%(hEN%fFl%yg`B;6 z&X>4QyF^-9WkPQJ_xE=nFfd6l#gPNawi_<9i)YthP8D{0Z9DR@XIJ(;u2Pkh6q%z{ zC&7v7+(^YctjoBhEU~y`Y;)u2_PSQg=cR~(9@&pp&OfE93Y$m3it0S0kaG@}97$`s z&^rOvl&g2S3_|nlm=&a(?X*`)E!xbX>ij4$hho4AUEDq@+8XE;jpPM++=Cz{Y`Hqe zgbZM)IjWR1UC)e?p_vWi4u!R?;@KKXl`$vEr&ngX{`+0mSHSBObQ$xrNeiyOh zt~*0O8fz9f!QwDh#pAQ<2wiq4pH;VH@?!7H2-k&vMJR%-wa5E!w2Jg~X1g*(?z-?4 zXCl!5V5ORBn|eUwqoawhW(-{f=oJfxX3fzE$pEywEWD%$*N{ICQ;21`EKCw@SngWl z1sSYSk4?eePaX~iSaO{}6aS;_#Cg5y@v+487yzQmUWTzk9m>|AnOm7zGhs)_wF{2Y zu^|&-j|+Z6kM`5AIdBe`X^w97PUPhW*PV@PeYiaXqHA>vE2{<<(CK4Z%8eouG9+#s zlD5-Abr3gF+QZF^DLP7?cxkru;{z)@drOLpYyj1f!X<1a39qDchOsW(fTtbv?7Ht? zX}vWxSmc{{c;~g2qEa$fVcUh-mvEhF&ScF|1ckl1`}TgP%71A#na-Xx5J^0A8w=Kt z@5{Ss!_74^_kVPoEotujmYsA2hQ%r`Zbb2gHjYp_TS7yUQ*jw?y<{jQ^F9uq=L`Wi zNVx=Y8+*i$cg+Y)3kZeo1dIrkhGIia+(`qHV@6mHf%;6 z=ro;VzR3WF66SH-1FE_t4Z*Wu!-Xi z9Va={V=Lgc_ZFEa*mX+Hb1XESE_Q%UHB&c%{dn@0b_{OV0}PIjVb4i@09#*bmzdH7 z7>nSf5NoSE73kQFXz}{N78D0e#m0cPfQo?dzc!nob6L7Vw|Nn0!HJ{+Ridk8>!XLb zWcP~=UMf*wami8|r%qso9YQaT5c8Ly?C3_mfjZTcxBQ%)I^6C86;=f=V0|z1t(JM$>emM}2M8o#yXrk>BT(eTowaMbMs)k5=6UWaD?cyi5#iaHW?u)j&&`U+#JnhZy zBko1qpt>q4XNc3|{ngzyvtPEPByn%GO`h2rn4AE1^dizoC@j*imd||esl-tffA%x3 zaGnmYI@%s?BA1gJukn59zVxFh(YN?B=q1SZf%`9s!Jy>z%-?iZZB64%<{tDQVib-2 zBJN5~*GJiv!scN=-g_YbF4`cn;&`hi?o5i%nhO@nocgrK#rsQ6&?2a-T=zX=$*&%i z!Y+2z&@aagzq_qj;XNN;c5b`l>xU-&6Y08v+&gZ6UffJrkN3YQ=fuVJZ2@P|r|JUH zo3xC>I%^0RM780zHB;H^x+!tQGF8Iz3Ym&p$3+Z8J3_){ey<4=( z`Cay<-C;`^8O8E8C)P#1WwY^Rs8_~YxG6}o9gEEZd%a^I^UzM z!OBjg`~DI}))18P?af_fU{9N#wfhTK?eAk6_59UMcc z7V!V(#s2(@UE&7?Y@a0nOD=04lnF{xWd8k3?_qR960!I;9M1svMit!57-dmrK8C01r)=Ae1nts7)P2qmAjGiVu z3QRG&0sN4yT~O?i<~3#_kpqX-#&dNd(C=+)JS*=^tO&yM82t}> zQo@BmDvZn5%u@=jVN~wvB^fum81z6Buq7)0<6ybnRooi7A6o0l%6Dm8j__1j%irEr zzH+yS1CX9)Mx0juo_~tkA3S&R}p2T3*pH z0xwO$pSduC&z|XV!o>84LBqbRNf2CV%$Y8s*X+&EDnh~RFVNxDUk$=IK>B*>DIN~J zGL@T?z^d}X{CKs`i+R5%zj{XnxL= zimMBjVh^_aM=0q;N}tAQq9Z=kj7kNbp`)Ku=Gocv2M&~O!xb)hu1h~|H(!toC-0XRarU}{0ZsKATq)aTGM4*s2WkW5K6}nb)z^1?gZ0mEK6yx$EPE$l0@J!pa{dxZ zEhu@=$lm~Z-i`iXFO*6Wek(#mzO3Z)!83czf97kdzN1bcsi zb-Oj;(%|$6cmw3VGS`CKuG@5H1!5V_2%*tk4S#R)l;W@77rLo3OBt2WTDckxO0Cu6`oa^tLUcVtl3%bul zxVU>DT~NEoLX$${9=tkmxVOQtE!o3?f!|4S=oBoa9x+WA*M?haviZU z!J!Ojqz=XsaTcMp=dq?1vR;uuaNbcb1 zKSq0E5lki7iMQa-VOXV&PK?0^Js!XK7U6dR0C85o6xf zqmx*8pViM$x}yFND3VI&ERJKr^;|F&=AY6ghIPiXM$C}^T#3CJ{55_^e4E}srjmng zV`Wr|)ref;|c(arZ#Tv5Vm7Grw`VYRk{6TH61??~g`rQv~%4eYbA=<_-~LW)u{k@ab!Q^#7S^ z|H0+gz6$GN#8+Ml)|l=zyDUBy(nU8z_679|RE>kN%E5R5BeOGUAPKCmuH< zpt~5N;km%8g;3`Fh#KbdPvGLQDK7j^2*i|>4N~p)^khrTmr4HT=`rNx6k5!h9rzu` zo{fH_q#MxktK8)7^I~Es_t&rfoK97WFRr=NOelnczy(COxh6M8)PX3%io zTfE-I$-tqyqSca8O7w?fAu2nhIRYa=jekyNJUcVdx(~t((H|Y$?SILD{86Kh3pPsa zM}?u3r*l(igXYH!T%J4kcZ?h8_{fG(KEww=G@nBtI#9XF?8X^h3}V~o`-^N-b^kOm z@4$W9=D+>ja{cSox944!Vovq{5=J6p;a{&?J|*Q^D{Ec)cgYca|7zV^*# z7b*@G-y2cioNg8wRB$kUu=+d^!hyVgHTC{~m6X2!0QmrsrcD~)M*k0j7+W}6{ow9E zfex9#A(ZH*ONc;b&c7z?`5nMbzuNm-N_ZxK{ny3_st@fea1TXQaL@itARt`mam(?f z+iDP-=E~?NOBJ~o>Z&Z}e$aX0d6wT^-!36#0cza{viue%84Vs2GqX)8APprE*zwH& z5>903K{!PM1CS4h2NbZnMnXr&K`Us_mqaWC$YwiUW6=B#;D_@Cs3N+_{3c?j8k;E4 zxn~GiL8QRGokTH-BeiJop__?O3Bg8S7+nHrDvN$dk?}iN67&Kjp20BjZMn@|A!3MO zpuGaR?w0o1<_}Q$zZaVXml2`?KzA=OrAVJp%F3>N0}tCAw6*mP!SNO#Zkw3ILDbMq zP=eTkNQ3b5Hc(PseWqIC(k8H3mTPw>@d(g>Ua^8(-4iecFl*9whQat=H8#s{4O{#+ zp;^{*Bpe&l$wps6$lEgUoN6J-h&eZj!*nLFzdv8|!`sk=OE;CCiTk>W2PFd> z*w_;UWjvP&RRVU#ZzaXF2{Dd2=gerTvv>b$Fe|`jEm~qPRCeLq7vG<|IEpH8=*gDb zue-+^Dobwk)9*2r0_-Uns-KhydSmrKl>-?`oSXLRXP_nT$uUZTOVdC9S1I%}i+nU){AEox--f{~DfCe)4CNt# zAO;M9>sX>HkXLy->@Zwb*q$LW_-joql}B!-J@v%_IB8;|_6OTbpz4WM((T)MZGF4T zYBNxPC^)IyW;Z^%@5EiTz`7L+3fPhvT7B%d)MVZtFR`Z-wtj!tY`*Yd`!`~8nuViL z1iAC(^=yem5gyhUva72fkD@jODae*bYFMjv`TN%N_turm>l@rg5+sTYpPZ!^k0rl+ z%d=|M^96W5-i*cPs$%PpPy$TYe$btJ-{kvQL*R)O>kppANpa5i zlMhxPy0R%J(i;qn_?kvY)+H1xERX|~X22mvz-spMAYuVWX!V5olnd47s0z+b}D0rXR$&fFUc{UYbKaNm97{*jyDVmJF6;y@<=@>9K9)X4Tkk1;{I(p}F5)8+?0-pilB#HArem*K*mFi+#Ozc3`}#LXKo+mr7BR1tm|mR$W{=MkPEVl+W2 z;v}&_UU{5FyPSaJn&UH(HE_{XJidOeti&v_UOYUHOMBXpC zYroPr)}e!L0~3Y9{lerDk9dPS@z8S|1KHmr4dM$2*Riut?Sj8af{!;F?+_h$t_2GR zCZmi7lKDJ6FJ{$?i3p#)7y^pWQmEMPVWI~^F&2&C6n)v+?B^b)*whDM>Q>$8tx zKh<(nx8AZ=k7+i8@7d6|mgdMU1q}xOP<>^IDogh&iiAXn!4;QO0b*~Pevy`Ems>%q zzBeH)Yc2)qqPho01u45nsJ{mO8`Y-*`*+UB1%vy^2LJyiXnU^{cOjk05_3xd{G!~7 ztIJt6IN>A{9eFy3U&(x;(`ow^rHZh_gDS2T1=5jeeOUo*mQwDjVb#Z(QqQ)&HMD3v zAzmaO#_Vv9kf1EocTy(x@f>bd%V)9kU4cm2MN9^2D1$Nu?MCBcl8f)pQ;xkqOGqY! zI%XGi5d51zxGWG6rSaRig!{ncpAD}*rYpG)@j-RT+eQOM2oYh2IozO(z))RC-2eEn zDRG53E<5u5r{}icOPg*XKqgDBXG>d^rKsH>nqvZ71Gt&0U{Zo);r3rW{n@SwBm(o}-2*1+@rxzj ze)%vNg9U^ARvu|$7w+^`3 zxK@ql{hEd>rJLv#@%isEy%Nc3e;lDxp$u{so&Q&{S?zA9pOFyBSjV7f0iw$ZlG!_? z^<2?w!U7);jQy6!*86u0n(-Hi=X3D|C~t#{hU16Lo6ha zlvF$YPwuMj%Om-}Rza7yDh54<#w^-R%x72qshdh7dmMM@;Sw~i&c}ydW>;nqWACZ8 z3UC?jW)Va{5**9F$WJREF!Lqd`j_~VCE9^`&lL?bR?EyPVFrp92iu934C1lC&1hY+ zu{ww$m-i#(oT$}nUbd(Gpy}Fa_f@l1P2>ZBe)O7>K)MAsH}I=$+b_KN1y^!arEzDW z&6k+f4|Z|skIasRI*YUP`XaFuHtw`D-qiDwcj+F39DkC2a@smRrvn$77 z@6~JK&Vw5C74!+q2=PL=m+^v<5ls&fF(HhGZ-|B;L_}`KekVxD zL=$LpbIu#HUCD3}6+zT<`_T^!gg|Sgu)*i?FHQmB%RJ9{tKd3+pA7UnIrjBcPK3lo z#tl=<=6hd3Rj;cOD!zizGq|jJC_~}{&8p>l{5;G$Chcp>lMMiIa z`8G#J7+!i(?XB>`QqyX-q$iF^Dkz}Sqz*3`_{4e5<8tdhHeas<0XyA{Cf^mP3cBq{ z^vjKrKzywTt$~9ff#{+xtx|DO%{986=@9;)WXOt?CMY=*N#Qzc1Ha4@d-&jW`ZFPy zd%g;MwnOTnaM#iE+{ zy`0OR$??tYM4jl@oTQwmJK^;+IPX>)IT-v)qRPtAL!|~E2YdJ)!~KyN$*SL56gJrvVrArGnQVR60Y9p6wy^F zxDiFu`}+3P)+bk!*DgcAo+3E;3@^BZ9k-drw$ntF0bEsy8?xZh#^Hq6J z7RE1Nxco`yLU>*wl%VtoRka$#J-8u!iWCKr|4YLE_iV^}i7+JiUN$$2X_x%sIodl$ zY`%mah_a5oxk1XF!4c=teTn49%bl%#*>@jtNiQYwS@%)9n5wN#D?86_+tGI=a(-fo zy3w_k+?nx&=cTgEiL(3l>@)xSyhG-o7OsVstv{N1)ykm%EZ^K0f;!nfc}Q9wGBkgp z?3}Ob@zQWTmLtC@tY=_HYM_fJ$EsrlqXe~S43eeht$W^V*ZHAB)i z^0Liq?UL*qmDJvp(!XJQr1@vOGjs_Ft*uYgqazJ*H2REXYkXr0^VQX@8wU`fQi8;1 z)MXoF-k=IdA!HT)gzpP975F4(*81&OU~Lf_%=Cm&(asq0jqL5%>Y@(Zxf^ zf3!dw<2DA3u{i_*O8rm#pfp668E!)Upu%%4yFlmNjpVbUDzjbB-WCdEv0@dN0YP(~ z{DON#=U@9^$DTeElKQP+I7VIWf>gk(MV)Hz4`nUrNdM_8UCXLX^l>=1brcq00gmqu zn0~6r003lJVv)S{N-a>ElP@qN0RHhh$gGPE_5fKtUhC!=wSZd)T4S9Be0u^ds*Q2* zM5B*7gt>Hs&tP1(8rWETTRU)XW&#jrz3--kHCfQE9>$HKCivL`!mRO7OOSAseyyKD zaM+Wpca;!8a}bka;&)rnf{<5Wx~SJJXp3KLfKQ))zzZ4EQHHW#_D?6Q=>d;}(Iupr5q*g))kff#xbHsA(Hp!?7HOw}Ox z3o8C=u_}2CDJ@8rvuNh3q>&-jJyp;l)BXKp-$p(8-+kanOgcTy9EcmTdPEV}f9aV| z_AkesWdmy7dyzSc2@sStm>JdvlI;)LLbA@gd(@gG4OMc_-=1}t@UC&4kHE zVZ4P!hCp^l{oZN%{IFimX@ArDh;|N0`&4I!p0Mj&Rv(GfB_kw4^QWo&aD528E`HDY zW56M`WEr(s2!G@?j|#U>V75KKo{lS|0Qr><;K^fZP%N1ha0c5*bRZSr z(x8b9<2r!FlXDbTtR^ul*x;n~PhiS*7sn9y2#6InK(??X)c2gZ#*&GDd%4S0g{u^_ z!5<2b%0@i&Z{|N!zG`OK!3&k_1-5^}PewNjq60O@l`ltBJAzZL7w77gGa)>!2!dSH zOLk(&r=N0d$f{#9U4yoZ^x$#d_VVZ(xwo;gD9E7CC>V=7UtZM#A`?~XN<^fGA;`|N z{ln(%yl4To+y`}P#zh#@3LHq4k_;Rn#UR6BDIRT^n2D)7C)ErdSpijQ>eGq#K7smS zH)0Y@;i|^ww)5m&az#AO9pm1MoLF3-f@xK;e;ES#rqCnEl=4+`Pip3)lG; zF!eWb9o^Eppq?~@zZKeeue$1vl#W#@CSqYIXqKs!ucf=+Ns+cpx7 zIwIB5)zTSg0@H`=`AX)ZMI!u2j48h;3jgQ~Ph@_b2m>sL>o(1a;5({Htj!`3rAI zQh|8pkrV^5}#%Z)SvyDM@^ zPm)}_@&v`hz(g2{GZJviTj-zzR$am`rceD6^;thX8fi8rG zmH2eba>~ivunVfL%($8*-9^tZ=jrM3Bdj@3+o#uk9*gd70Qe$#dLSZ=en`gtf9?Gy zhyED#g1Mg&;fwCNV_k~(4;Z;Za^b=ZJ>I7m`gcIRG6#a$+>{G{&H05ez-z^STzvhe z^gN4>wA(+*?B4v!93UIFXpKjdL^1&&pzTN+5Ww|OeMG~b0U|{5T)O#lpiocv1pK-m zq<5hsL_BSP?J%6#aR~M4nOcFjj)0bc?NHW6&n;4Cg}-elk;I`osL)&>P$ux(475O| z7KOOzc4k#jFA%djRlqI{fzH7a@2&fL6Tw8A?;L9OZUobA`mTW*EdC)A85Fovp#9t* z+sXj%S))7>)q}7=C;?(0{|T{%?WnRE0oI}8VGu%CAQlkHnhR^@g5+hbSF!y?272x* zV}%`0n6+2={6X(eyM9C61q#|cSlXK_<3?oNpxDO8NE~Y`C9+?@qvA?L5@PRMS_l;4 zS;G3?+`YN;6G%g)U4bR^&d|cqD?)jVWDwI8-B%GzsJ{X!;!pWp0|KN{%pTItOtnL87oGq9F7FStUN=;Lbl9l~YO*fVG5B;TVyJGxsSURHVOO88vD)8&19$+PW1%l>_Qh6WutI zhk!w)D}+3xTrzx8jZs#|G+kFkBU%_7PvkUP!BxWUP2Dxr%uz6D52G_o`GqNZ;Dt+k z^=?uBnH=w}1z}&9ZcOE~jz`8YK$gnEJ&+9}#Z~Kr{vVO2?Pr04=(*VImfIIDji3)0 zK(-JW`=Pv>#$yrQDX-QFb~qmnc)*5!dlvaHi^gS%h0FAXR* zM{;|BAk3=)P`=qf1~MU^>PB0|B#&9a zYm9}0Xl5M5g4&=xdbyzr_Y(Z>Oj*bXGWPZ*;k$9w}B4zV}2U{u74gRTi zCiyTTQbf}%4fbTLV(N(rcmdNXX)?VaFnKL~7~Fh^h^KAFDJL^e9h9KVTue7Av(=f0 z0h*Zrs1ow%%#km$ec<+VqxL-Bn|%ob&%)7r>|-I5YHw@yUz@k5Xw0H-qqj|}Qf3?U zmrF4PjWBYAzS@JK)j^AlLG&T6G+cpl83bv}-E6OXKa1KdHIK(Q0vL#!(8fQMZR1BGuWj>Rxh0i{2oZAb$B_RO>%~0vq4Z7RSxKdy_j&;f9j{a^%b+fQT}n@g{)d{)pl-5*cJJ zMgP}0{aQ`Fxv6F=`B3^(rOqdU&vGI|I<-!mZ8uhreT6fxbhyOx-ejPUvCE60Pq5YD zd6#cqiXrgCRsyk@pDM92hhti4y@2uH^^td%S$bZaH15VuGCm(}h&>3=w@(g>`q`*2 z#A;OI)1(7FCG$)bv5O&lmfSQacC(f&a%4Gu*Ab>IH2vqalW2N4icM2`d- z1MT)HLU9CwJ3ioM7`yRba&{V7-yz827utyoFB36{BKFdGmjZM*;c!aM`zmp~e>G<0 z`#(A}z9GAD|Lfbz5Wlig(J_i+mYae$P9V1hvV^BI1gDhYAH$d&$IzLAgX04Yzrf66 zQP0(Gr(ZtorwOFpF2QF}aWW5f<~+MdUa+#uVA1b{>Lk>}Hv1nj22&CJCy2MTi+tSD zbv%!AD-+Lq%o-=2Z$3zWX3tV#a#K=m`eWQDJ+{{}@%}9Q11fOL$KXBxIp)7&Nf69X zA)PXG&yo2bofi5p>%6y$6ZJbBO8Hd{Bi~=4dyc$(vJ3TW3QQryt8D`SiK;-(q3nPK zbhm(?P7GD}G<<+fFzB#%4;FW+-;uZ3mHi|bvKJ}S&YOOsKO)5iXs2AG!! z4BB73etih?C-Bvh#z9e)6$bUJOcBy^NS^*wb0&*(s6DzvHfM!Ki0g3}@f=!Vnj98| zSV=aOlq`Rut9J^z*@8$mnXKjp3ZDwlhmM?^(qj5pw+rn%KYO?WFq{vU>-8&~=Y>V> z$fSDV^b{=`z?hi|B($DBQOOYg09btEq>&qBA|-V8DfZL~Hg?@drq)0NV&1oY9;y@9`c5y%9gBQFLxeM;W8rr*ovpydQG;;IRk&iwbVAMwFpA+?!DUdX z05cpcw_j_m!|GImJK60RBo+Qk=>KLmJkEvNaY8b~|Mw6#H6+Yb!062r%hxL}nt9I@ z`ejt$DW7%re+udcNusx9wNN`NA&9);7`c0&SnKCXHzV3iR|aH@ zy}PGs_LXKe2n&_nBEDMCu+m?362Da;uGzZ3+6($HlIRnPYZ%Y+md)Bsu*`o$66QFS z1dg7(-`+G;$J(_Ep4=CRB~7s_s6l5Zz$4XPd@|LR+;yJpvU*kko2v%LB0M>5wfUOU zq-+HYmlt)>!l<#S#Yb)8k7tBO8l0G#n_NMt?l6&(4-e>qBO<$lPw2m>JZsdF55wXM z{cw4{q|kbkNiRnUr3kXxb}a-iI(<}gdF)fS6)>)@k3UqCG2uBvpI3{Gakg{(IR)0n zp<{8EvGeH%4;+dw3GMDzW6`utRT&Fv5GTv_x0 zYWq7#Mok83C7pv$dvEeNlUn0^p5E19q9~y`las(>0gW%c<4s59wZD(1E$JD>-O|ik z=yXSV8QG%FU-2KWtY_F3gY5ox!(Yc%>9{!bNIQrLY!Avbk)VJVFiq;celdvF8ane2 zIFxT+Ka;Qx+V68`uavLS*gZbWl#tw`Pcx4}7Ti z?wL3f9+29|=4it7s(zb_OaE0H1g~!-%Qy)*n25AkNLl#Tl{`;5Uq;XPGd;T|Mrif9 z65M&_1~6M6+u{Hc1wKTX(*zxg3jd6TS3_dZn$-`P4bKHs`(aAuY|jL$cqJ0n52;z> z)K*7^I;48LpUZ3+^;1io&W5vHS%+aNy&Xo1mADOb_Vq_uSQPtCDmc2u_zTTU@+?4` zD$@m5A7S)xqn%C$y4;S9c&MMXi$g%gbhm?UH3Ny>$MNgD{#+w*fr(ncHsxkupuzWw zq4PR;5mAkd90K2f%`c6M&QS)m-7%Y zIh^jwz}+`@I+kL=4Kd3f3bgtT&twNmAvuj((u6ED@DOaJ(sTz)G@;rUV4M_M22 ztHX@NVjc&9XAcySDrGJY{;}-Y>9NsI&Rdg>ml|G1koxT1+V%3ISw1-`FS#AJc=v6k z0o&__@woSo6yOy#5#2ysU%yZSYA?BV`S_@uzdu5OMqO zLNw^t@b7F#g%8()qU*}o=q`&R^pGlsUegq2;UlN>dVfs3OJZL)%{ zm{8@lasNylt1>0x7b73)^E7~t+w|e_5oC)w;e^JcVV-NLbX&}UF#0;=)vYBT8eEZ2V#^S8)PgvQMXAHo=!b!|LM_tY{Tk5KbScHlo<~Tkz zkCo{W%#QbwjpwS;9#Pd}C&^^fw;_H9dKe{Kx38lQ1V=b#4>sG@7v8*Gz}!W+4-(en4jKWm;Om@tZ7b@$&x z7eFiTc2Y=Si$V;vQj z9(-$U2iL^SniQJ~zPpMFGYAJ26s^=+s$jBBweUDW?HiL`4T1?mWo$G(EEGHVom4R0 zY}bw(qCh4@jYRYxY&>SdsK4=CI>dbBqZ1FziDXDXG6EUXn8{{RkeuwqHzYpqv)LnG zNrxE8gTVn7K(}cgGs$BMu>e8TC!2b8Iu>N~@N>Qgp&@aP>8F56vzAt=Rgj4?937P7 z@HUaw6jE0Fk}_Q9wohQ#AORqBp=`86a1@+17!t5n3Bxj+^TCmd{3e&Q0iJ^zV!Uw6 z1-Lw#5LW-`5iw3V*859N8g9)TgD&w~r9PX^hHQlLoo#pMs>u;;n`*u_%e|ZT?optCVb4JhYiD|u48{&_5o@0#!$rP_ac8=7vQyKp=6@1hJ zS)sBi5oN$v1-6=2(!lIg{HGAQy40XO$ZzzlFU9=!MlquboH;|-+9g% zPLlBh1<&e(zMzE?;b3I&)%Fj&_*3MDilLfa4@qW`*KhvFT3=k5$dWANwol%BQg&#I9_rlrY_2> zsUXdYw0OATgtq!6tb;8GPc38rGa@RXqA|KaVeKpJ#JM@mFGB^4z^1(j|A>CR`JsI%v{_kQC2=bg`X&wTcpIsu z)^U6n)e!?kYaTpMB`z7%&JE$Av}!ZGCkVOYT`HchCe~XD;=PS;yvcTl=*Rva;H1tS z=QQ;AsQ5XR$4JM+!y z762gp9D<|iJB$wm3qTtMU6RW5ttSZC+(>1Ful&bP{$<-r2_2dI@JeQ4-<1*UD_&bm zIYXlR4_U-({IYn{Hy*^+Yghht&GUI^Y_)i)TO4oZGGS0MO~XIRnV*h=7GZ1wk;Q#Z zsnFQ7Q|`n{tt1UBS`z}*sKl74aN*!~Gv_;Pw>n<_}t@=1uS}ds^^h1qDLW{h@djI z4X2`u4^-Fjpls4!O=tp~&E5|8;$TW2Q8>))4=r7#uu5T&BA!6V`*=s0k z<|LtLL#}sZb=OUX(02w9#pY`93YuCtO0QjjBdpSEvk+Oc=fnVrhg-b~sZO64&&&i^ zdD@fs(k@WC?eDmtc;OltpJA@?XdIUpIBP60(DNEs4Hy26BD$uEb-&{HE#1AMd zki?HpQWC)pi>TN=^f}Gw!j*)tJ);RFM2fiDsqdq*pA)rrP zr!#Mdp4rHInGlR~e%N=nK#+20%DKPT*pv5q7z3B^TndYvrC#i6oYNh7whpn)C`ko* zioP5ffHmlTFn`Mirs4}4^Y{~2OqOmFZ+iI-ab3Mg)VC}$SIhls$nLN4LRY&%Hp7^0 zMFYQmmrD?qx^U`>#@(TsTl|J~ykPbdnF>z_$O6caXW)<)nW_jo#tqCoz#uNAUF^Aq z&Cey=8?~!9RO1mNM)A$QzGYDuVuY;>CE_S3$DAtFx;d-5+IN#_@J=+N#OD<9a`*E) z$B50a32-@v+{X#k1XH_|Zdpn$xE^~G88NrKdk0C#$aM0_ zEB~Y!$jIB0OcCSloF+IsJh;+{)mdG=Jw(v+g+DBX{@8Fxb(iQ(r;$yo`bO_3RlDzc z{r%has%0C}sRdZ4k5ev?Iyb;85vIm&#J~)JY1*9kRj3Zl04kBfH1g;x4vy8O(j}?I!az4pXKs@8xP=$kn zMQ8f6N{RN`#vn=;BYQjN&X}D3mMf=!gk@YiLh0Ow6x*HXh@&YBd7u%F*cr%_e$0Wh zHr0HAK}GR_$Xu)F29kb_J4TH&&zWB~#be7&31CZs>|u`)=DK>k_1?xeJ7u~GMQQ`O zPfxWJuvqR=$6(iNPo)v)0XPH$M?hLOM03J@lgl#oL~iaf#Y@r$ zU~lX}1Ic;FA`!nkxdXjNFPmXIlQKy_Lk4xD0pi<0=8XW*d zwTRLWoEvxEQSR%0yoK@6OHS)-xaHv1E=d1Y33MN=&~Si?y#p{lI1)6LVS@n>JB z=mk-ivRJH?+U8@)T>-qN3!NW0NBG_oo{PH6((Oo;c=Rv_zg$!@3B%UQXV;M+%eF!Y z57iv@OJx^+p4M)VOV`SG-`h&q3*n-BbawBDg@JSEiHnAp{Vh@k`GQ6pgSb1O1koBW zl@Vz6HQ;H@$wEpp&DGCMz6N^&;`=q4MkX>aP4-1+@%}FW&p1>koG@R2`@P!@*HO9q zuWNd!=edw6ckt6=cH~|Dox%SfXEHjo=Z&-e_h->hU=Xx?_fSXCHVUOxGL%L1VE3*| z0ul*8bib8%r9|q(zkX5!4h#s-2mhmF2&3G1Lp9G(6TiOg`3RC5MSG>@QD*Pg0|lq8 zl!*_x#wyl1uOuouPQ9^y7n2F*;4wFp$u%WX3jQyFFfBZTD;f1H;4c-Lk}UZ2?T<+~ z0~7guaA?olJP{P}ly;xyv)XNh2}{i{GVT9Ms%?oZ%66#c6hzg}J;^2h^q@0c?9n)n zbq%!CjNIshEMdnHcwq@mfiLmdD!0YL!(7bIko0m%A1i{;P6yoS6Y%KJVa-75_LVXH zrQZNql>0=-_&Y+IOU5vr7xx1ND)l)AoUO_5=;(mP*bJO(JDXgqb|5|H;$6HAv&Y}Q zJ7<09w(h~L^%i9QNzk%dwHNl+dNs%(B8K{0m_E-+?(vnqgt5BKpC=$-b3#2E7(Ipn za^wPAT<^9$@Z$!hHx|Jo+^Sb1q^FDAz}DD(*oA{f$$i9sxMlb{fT*?N2di5y1Y;9V z|8ZJ<{*h3%u+;|@(EQB7*+*xTP2L1gKFh0dVEz8M4Ks|-4aby9QQiy9yP%`IT<^PI zN^|qyh_b@%C}CpOm8pNY@lSv(?Hj<#sX*f#UF%7A;0o$SBBWptf3A>Nj&kEfwtertJ;N5^H2CWE5L9dv_*%}mkNhRNHO0$p0Uo_HjQR@Q$%p*oNyd(C6r>OL1R*w zynHsjm~B3Zfx!s_goYo}u8f)-q>YyWX7XzLmfkox#XrpPL6r8#aC3{lEM27nXa%dD z6+XLVb;7dQ3kyzt81)e{i~Cvki?r2?j=RC7{^#zhK$~5eW5L(ffthXJ1BN$g+;ImB zgFkMl5m#*75F8_5b2SecjHZAZ6f;57S8Z{KzCD{Gz9)gO|Olv-s2 zgR`xSo5;v^RH6bjSm!g{9nKi6uR;nP>|TF0o?vlrOztnWy2=O-Bo>fIKCs|K?7*dR zIqibYMD6Af{%#t4psL_~dgXJsX7qxo3^ot0bKTyGs(v2~LpZ_XUzG{W0X1aH|JKx0 z1*+(dNG1pdidYZ8LHB(PO62n-z_PoyUylzLzq9gc!^SZ z*8)7K*GK-?aZr8Z0md{V%Hp2}HPGWL8DCQrt_PWzR4|d&q}cx$6$dg?t|0dUYZ#f& z$rfQ}$uBk#+MKn@p#S(OZP`h#tHY1m+X`-R+r_@*6U1ZudH9<=FKNKtoKQdF5wXVk z;bj2Jkc)PN$u(S~LWA1BlwO{`_B0#MYr>Z01}9V*M*{d4*()ajE_*(O*u6SNg!)ONn<&BpG_e-Ydjn; z6!e3=9B0=**VfF?y@I7dDVDX+c;f4)BE#Vo0LQ?^_0pZP<{A*Bq9R`bqM>7fl|?qh zlVbDEKc@=LN5I+V-D5OcHINn2hLatsLsU)j4MFKddr`T1?SBTq5dR3BqTfy^*pc&S z=wu)rg%(@~Zc7&`p_fW+3LLT8+geUFQW~V0-Z|s%qud?%$6;sSL)3ADQ02e*DX{m8-X2lIn3N3yetDFr8wZ)j560AbzK zTg_(80E+#|6s**2q;Ru=V~-4P4S#&m6D!T8R zX^{pmbUpweu266Ypf2_(d_yS;_Fw@7V-Zve2&9Bu;_p8NF$sW+W%UEri&Qx9J0i8|@DeREzsb?M;YHKzT=gd>5>WA1az+&Q1Un~>><{71mxb8C2bI>(jt zn~_QUo9C z8EgFw^0{vZMjKwp?+OCQJ}=8R5h|#;Eg15e!+9mnG@K)E4^QZ(P|(o_e;NC@Is=oT zhM+aAyObqeTNXW8@YI%@4XVidFtw$H+A$kbdr%6xrTKVjpb=JuhW2$Rm~3dW z6bE5^G6{I*cvS8oLPf9QawGJ`lkg)R0IUv)#*?5b7z{sxm$b+FIf#1VB*Ka6lv?IA zA@AS6lYbb<#y}|kWKP1H5AeQe!%9b`I*5xi)&u1b9Z5*fhL?4e$DYmtn;<9xPt_l@ z<*~D6maW3X<$HHd5aNsG3HkwVPdxU7NLhe6__)r1aiY%{>>WFm7 z!3VJJMFgZoaHd#JN2IiRvq>~bp(4#QOUbDMrP_8oL0yXGgqLq(kiWSac*FoIouQ7@ zAOyokC=ugnsFgnYW93mR0f*yAM$mv-}P!ab&@meGlGGRiOU7 zl8Hl-e1*ff@G*I>kB~%;2RVyQ*R`wHb;(E?bQYY;NS;6j#-L=N)y(>)c08(}l2*<- zj`Bc8T)784Bx<#gl}7n;q=De@{kBOi;7yG(82j`Sef=EZ2GOv?nh@3gMXakdd1JQ-)t zdw+kT>&Ztw72&4&DC=Ya)p}xGYc09GA(P9H-TxC9Utr)xviTx?r_W0kZk)JyVC#2* zdj|3Mq@w1re3VDrBB#l}V0~bjndW?w`HW&Wp1&DX3_mp$-JG}BA1VS^5W2>|OFbwO zltHWbfOG;`!E~5TUk2Qq3ta{~t3zlm-pnyX3vdK!1G3~QBLNYL^|ZW55CTo$sDf_Z zf&0V7*KEM1O^rt#j3i~YgQvl`@&G~^bCN<(sKxmJ1u_B6rZW8wJoY8oES4OJ{{V~ltk`L&MqvJH< zZBbZ1 z#7`_#oEST}RqyL#8oOyfd@0`FrnMih?&{tZ)7b;n7XnYR;H`zI!P4YG)W~sK!hjEN z+|scH+{q)GnE-QtJw*;DkY;Tw0uqK>;QhG__AFtV#@o|~)`+x20G#<%((r~u;4KDXrLWFhT*Ijm^rgh4-Q0!W8oM`Z6JiNQ%eJM#Yr0$fw z7N?u&u38y$F z-jB(0?ZwB(yYbuktj%cgU7U&vFAEAg6NvdS3<-x^*D`YEMI7ZdKN5%uhntYbyJPJ} zV55hCi)02LOshYXceg)Ns6C@6vMgoKy4$pmSEh?hBoiDONw^_Svxj#_PG~~N$ z;{nkd;ci)TkK64Tjk@|rlp#9uc2G)|t(rA?3Gj^Of94XSoE!+;Gzkb=nl-hU?PL?a znOf|!8VBgncwZ637xS{j%>f(ijvc&ypsLIhZt@7T1yb|3+bF)c@mUvAWc~N;S>DRF zoTI2e7lqGq%>K&Kqkihy+H4-op?Ow^ST-G=&msBz6J_%Ql~>QKj~6h{(y~0Kd+_J7 z=J_)ZSikKc1M70Q`&XipUd`kjIEqq#a)xGNfirY^8;~PWsrD@!TGt5HwTl-M8i&WW zwDOMsxe@Pk1GcZ&D+#1`k&fJSP=ms`7Y7f`iQ$9nNoU(*bTo$|KJQyw-S}b;UDBI9 zFE`)4Wo5ox3##KU&b@RrR=Yvdvg06qOK=_UzhuOC!+{?YdQ zlg|w@?(MKC&z)42I=AUqz$0E8@?KTnF8~;ZL4>tTRf|fz_4{0&jlkR7zIhfetV`

o_Ja}Eq_$JlnNiG9F^%*>8ego2{X9=ys2-i3`xf}9CZCy26Vz@|JL&t0^ zmodhB2tmSwzw%!@iU~~kz4Ku80}|18pcrUK=|6oHDG(w2IZJ|nf-k6-1z^=9&RC1N ztA}1&XY)-<6|YeG!5|THuAvI(L@6my=pkdoKfy!W$9F_`z?=ZKM!9;ny0Yjo2#cAa zEhM?JzZuZTMDceVbHMV{((f1~VqJFPYxyfMOQV{f9wvUq|1y-`CA4$vQG6wKx4*dY z@9Y99?LoP~gmdqR}DNGhnj_F<&S5H%Y9~$E_KyP{a z%d4>cQ?V|Cb)F9!qeA}iE&9LG9KEU|ckR(f@~_xSBUK})N4gVm6}Mg+5QX>vFF3o= z80g(Hlel&bKrjU-nPDMOx3Bu=Lj5yP9SThy!98y!gBuk}qE?TkbC%sKaL7jpPNsqC z@CMY_m}fJ)-}ADZ{WRZf127n|YARvCviwX6oxZ3}=_?8=vs5ype2VLVs%=Pk4%GV% zr+{p#xN!5dd!qtVC2zY{f3;iDg`7K{z>>WCwe(Wm?t(-mxJLvXaj3xnc9Dt5a5o5?K!^7qJzb;QA@o#{G2BlBGdQyF6BxRu2 zAx5aUveE~ToBLAdQ@#9be`F5MGo_51SEw@*)-gX-9gzo;L-W&%n<3b z4k42u{OCB4#)ERh%{tR>rIEdZ(Oh9u?}db?2QUnAsf7>m9s(P^OoS2=($F7f>P6As z8>=yTvCI9`*kWKe2;K%?3%gB8F{H~9!G3Of89^VlPIp=y7ZpH5vqcsV{}O>TO-KTh zH!EH_ii#!rwhkiU(G2iY*qCfU`Cj~E@d501tK$9Cr3waM^9FwmIu4dL%*IRb{+mMw zfd(`0t^EJZxO&Hg3CNz$#b|G8{H-++%<wxNbUST<23zjRfwL+}=zC z*cskqN50h_a?!FVBOW9_Eza1X%u*FWWIA||H2%Z6`p6L94wf2W;#QtjAz)on1shD~ z@UKy08%6+mATPEC1ZsI;8-tD-4_nyk4Ol)y$mTGlrosX`)W?*PClIr-W_&IiFQj4c z{Q^hnVN&?~*Of=_Xk@Op4Hpip{PoF8qwUe1*6FM_g;^KquL_=t%J<{eKjtlH0Tp_yey8_N+mT42vJ$I67AuFj3oCo#z@qcGfr}``PoWUjs zt>9DoLkL6$9~Zz4F6NhIV_vt2_g6LH zNS~ssF?xuitVB_jd=s7UpuFUyjT+VQR;3|U7?MRz1_cH_282bb?75tqkxsT`k&k@# zmfJ>?UYzv4ExL$%`IyXE?07&wLvk?EGCt~9cQ6aJnC|t^fl6p@=&w4QsJ|E1#Sw3i z6)iaBzR@uiv$CF-GhO?6S6$eDnaYuMxmJ8y)I|Sw>|SAga!Rn5nwo28=rX$BT*bqw5pj@0-#eO11i38IeNsiJe2XPqvFP*;8th|DOso( z?Slz!vJkoOS&Mfxgda8Sj`-A!v>#u}#RvJgqxBz^nYSR+;w{4y7`8}f*PbvJh#__p zR6#SS+rp*hm6>Nhjv9of|1m(lRPqRR1!(8r6g0)#HTf@wSj9U?$)X|o=aQro0e>$^ z%5jt-Q)-Wp<#eYIlF!BXKbv9645q#j=+UUu8114#nK>FaK)yIlpbl8H-@m?kjw5w5 zPOP7Fc6H>()|sN3-0|ZlDY{um1MpdBlt{&#WbIWbc+hkTm2##1>`WYBnfy4+2d78n zZA7>BzP}EpiDER1k8;Qny{4#npTO>10)EiIL$JnKk)E0uI7UWr^WQfq;jObR2@FNE zCAaF5+K^Lj!~I*Z8yC6R{%?Df)=huyQR<|(yhG_XoTtGo#pQIwU*?=Y5x^Q5p3_P0 zIQ*{RIM`KL;iw^`M@g}9^4x}a@Br3cAPq*vo3YqSxb@bARX=$wb7ONr8N7PxZ1I^h z)bvg*ybJwJpnNg@Hog3I)Xpf96$Dn&YYwwr$Vo{<%aaD^kq*Wt5m^o-2yIt>0}9$} z`9%<={l;qZwX{|H1y)Z9eBDo7?C49qB0vcRH`wb`?sc5mE7`Q>ZVGor@FR|x*!>#6 zznzQ03?3|>cq*HbEVWCl^69Hfj96xdwClApo0|a4g8Zm_i|TBJ$ie1JLRtSNab7av z%^M}n5uk~^hChEBRQ^t}Tqdaj&7n0V(#Mi2tue~w_t6jK&u=2*|H#0i{1wWgpuhgR zO(dipN0VtCW^(GRPfw$DmC%;%Dzt|4zsiFv2J53|?T)ux$q7$*btER|HN%HJ8N?#@Cx?sfZ|al*X(uzS?=YTINFj~4GigrAqxPaY<0kch@T;t3 z9^bs)wzvm?h!J$hJNu8MF3_HSeH#~gkvC7Rgkr>AOpkpL`cSTK*?nzq^2TG+!vOIG z0Z3?roTCnO?K!$nYdaQ8WH)~qbkG zP^CrxgYpg6Jlau;cNV5(N#Ih1@yAhEwsm0X*TN=(@^`=S*ND^#mkMa6*#LV+ZT$Hs z15O50ze2SCn)M0d@^Qp4N?b>t^Cpn4qcs#i7a0mLdoKkDgFE?R91|a^u%z)^09>>U z&8^GcuN_S`d}tq;aYt%LHd7nqz$PH0myC!PFzIGR2^RAaxdB?m{00~u7u3?U29Ys3!IqSUBB6H~j|^`r|T5lJrqY0Cww-#w5ZIwTfr z*wL=ZV^0k0eG_54uWtc|`&T(*@Buysbw_9ZE(8Q%Ya9>u6#y~BgLv@W*LWA#Q4K*d zFtBidA%NtZkg2`yd{c67bs5&z>rfN=>*PKj|Gt&2N}se6>yx zE)&)1t~U*S<-N#J4DekAvy8#4KN(I+L@b&F z`M+-)C3mac7B9o|*qKi33{;l)p_Y=StU(UWugWcOk8#Kac1M@M=;ks!RHSeOD!#BN z--eTI1wIV470qRz>tk}GxY{Z0$KCrV7X%q^5~H=*PaP>_Z@@-`Y3CjvVO=ORRHonGuOK_;fed7j1-!Bg{3 zS`j=xua(G60lsvjImA9O*5Z>*u%LDSEU(J(U;rU zwP9|6Jm8ankJkp)ktsjwMH1j46(I-X?IaM5tpx=q{sIkI3A7n@l&g$Q%TiAl)dFS4 zXzvgAc6G#pN;=MMbVaO5bn+R-UpUdXd%9?fo1u2u<<5D8LQtDm^Pc*TmCnKhx%XcI)MnjXo3k z;(!rOI2l%2>FsEolyoou1-UC6$@V|wmd0ub0@=MYLBNzd&sADN2`i~OelAGB2%@H! zKXY@28b_Vu<(tds=ak^%2wZ@5EMf(wrd0ot*917y-N7#WujkxsljvMxG>PBXc5m#| zY_D>zJ6WNpW6$9M_fdPv5xbhnW`3G+Gr3#$TKKqE%-8CqxyBnX!RDWz=4>d=f{^3? zbbRQ-qK)I?@=9TkU4!dl?8l?81U?17&)pifhO__Ckjhd$pyxX-{cG}qs6iXWM?TXd z@92N*cm}JePewBE5Z}Ou9{sHU9*{q*`ipY}m9$#KVcReKY5M)=0KmBT z-s3lkAgfIkd2L2pcx5G+y*Z>5?+psuWJZ({a}Z$wcX=9qkKewGqv(iy83}V>^1bO! z)q0IKfVe%m+T=Fbr7Obur9QEvSxGgfa^d}da#~*1?Ti?P6>aYc^L+hLIgt^RT)IV zg@`sDA>09>&pmEGDkZAyb+xZz$;5?y;#P7wvU3!O9@h?j}RxR{xp_*F(>eE|D z8VnprCDfx6&Ej3k5pe)+-VRXpUl*FAOUMrnq7Hx-@WG{?08a@^qh;8zhju_sLKKnC zeWYL=PK_M(@Z2|V(3A$A)N6)reqNAyBQ!v0H+Teom;~Dh8(2yFW)~y&2>TY`Nl{As z9}gnk$C z5`1I*xqdkwMD@xunOaFI=D=V6iOt2<~}Mxvj1;OibC zSZ+M1d(NrquHFmY*1(Hv9arJzGCd6gVJGF?l1pem4)YK5u(HmNU~T>mhOwz9*-SW&*ATI(#V%e5#XVJ2w=}Cvc;6yPEUyqG16xth;$?)!|({Dc8b6L#f*jCoI8r)|$E%cJH(-TO( zk_B#i8CZq-H+d9A*j^}PPy>HXAdq@b)ASouG+iStC~^L;O>?mQ6#q-$U=X#ioQ=U0 zShwyWJG8r+DnQ3B_^9`Q#F+VyQu*iFyt~A5il|~k{E`DBQ&S`0+yd{-@V_!rtuoM5 z_)D(ZnOLkzClJkHx#bzCsCyk`X?M}25e$7i*4D|erQRJ(@i5WuPhpdg-N*IL+bp(ZlsI6gS4|Gr3BCW%=%0 zf(H*fJQ6?5+x7wi-W&#2&9om~Bt-7yH9IPPJ)Xt7-NG8!3yv1gZ3BSk zXzds+X$wP*k*LF1ups5z-bKOO;j^SI(IAtmz!pwW(7BAU9QEhd)Xaeq7HrTO6xEmdAg5%kLF-sLSQG(p} z^M=`RH0q7nB583AG$*W~)zR@Ls60i|vq*ZV^Znslpel?}U?wALAzC>L;5F@PSDS5E zV8ZElu$>2f-PboSJ2R}Z*^v@+rrioFdFh)J#W01b-0%otGq@_x;+d-MdYMI zTkmO|GXMUjH&JAt3Tt=fQ5**kj|u`FKfiq%qOFla?)1UgE&17TNgAj`1_WYX=fV=s zn_!25VAi8wQ`6v}joI%$QvL#Q*FT)~h596}Uisikgh?ON3u_`)RD@VH&Rg||yE3{` zKR;STA(|=~DIggM^?;EE3RNeyDXH?%bd%AZ-T?NtL9&8SYD{ACH7N>NGb&ww zq)P72zx)6QLA1NnH#BVl90w?QiX<`wjjPkD@;j_cs+Vz|iMOzMRHz1-^>w>&9t+mn z&R|N@c}LE+BjpJtK*&^93Kakn{c;rX#%yAu(N2p_4KGkwum{#0t<1X642fBK5ifSE*&KaPY zGNY}$rbMI(erHjHm?+yW4eqzM$V3AV5_AvzNGG@X@$I-ci;^G4^>ct`K<){>3VXS{ z0(XLgkvWHIez3QCBATM0lHvqRzgXEK&EeL#4~ecfBE#P7h#>AUv%H16RoE%{2Fzl} z#vnfY_JZvI&-pta;~}I+>x4NBLj^wA;FAE*sM%7=xJG7gDciou9z3SP?{JUJ3WFPx zgCV>R$RZThLtcwgd~BfxZ`HdbSEJzrxQHCSa1rDnLmL`dLOmIWvIEHO1Zl$i(A``0 zJb@5z2QuOy(+1jm5GD2y@`ul|4#7Gso&k65KJ~$7{oxzX56t1HK|7}3??>CE{O;BE3e zxcx3Arwtrdd{P=P9r2r`={9vyoNn%Qo8rwiJ-1yI1ECuAK9ueGAxGaU%I{qc>7Q<= zDA)@ViguBTBfe8_v1Je2U=poLHIqoE$Ohh=xaZo_1tExoEYi&#fKM2O=v%)kp=>mo z0HMe6AyHq172xsE0viM}^%ZH~ehU@TO*`0+P_AfZ+72IeZodPdZYEsA;8g2O8UKQq zxAEYX3Z~$_d3FM(o?$MbYm(hVF*}r=mS-ai?k?NHS6J4n~Xecv0{Ln z-urk669tQsZS6c{U#3H)cbFMiQkqF+Lnh!zpTG>bit!hA0v;^~E04|tx~#<7+-jV;jVD>1*}OVAFS~;_1Ku5R!UQ$jLsy2NMqsatN%{Rn1$rgT_Z5D*Y$DP!*s2 z4x3?Po8Z=yztdM(Fpk!h7oue^;`@Gwn|`bilEFh9n=92ju-8af^ek2ctYJNa!d|Q> zXk*2Z;=tRv8};zVo=x0kzQl5|TmY`&zagvuu(!V-ITCr4q(}X8MLI$~8+sx?_)5y0Mmh@Rjgo6GY z_B+(Cr%z|@1wt7ms&E>0(%T+tuC*ofUwD!^HMcAaw(C+$8lx;3Sld!y>HuBs zGmv7?{5XzM^U~h_=5U|G4Fm#&6y94TnE6GG>45%2ro3dtODbm988IhVMcyN*n&4n~MEa58D}o+D4@DPJU-)raM~Z&Ju?O@$WDXiHIkbHPTEz@Rt0&-aD~s-*$qpdg2I*SBy@{S#liK@AxhW*4-G?g z(Nrw549L1#GCtRXB zZ7qWv1C4Ico?^J(YBX(<(~DwY)uX}h>igGAeNFGckqLLrop*S|jVH*8xhAMY6*!%z zv6+qN@ZWQ_8$b^0eTHn-xpre7!@8QfM&;MU4;~2)feUS4_Xh6Ccon6< zFAVVw7yrB~#5!*s*xxsf(bts_-|9;0Z{*`L`w<8bNtT89bmI1fxC;b!b3N&cPzaZr zNH~%m>@WJ!XL+{${o)S3UNkE>yPasnQ0>MuZKb>( z&yUbFyD$WhiR&oN!6vj-c!tkP3g1qHdsm-2lJ4Q0<2uNL?O=H=D6qpI%fb!z{_fs= zK4AWI$v8%hi?R%xKbJdn#?O?Vywf{APagS@Rcr29J59QbpFvzT6a}eUZOhq{`RyA$ z+fIJz&~&%q?@&8jsi>ZXHkr#6&cvs9 zI@o7a!Z+snG-S|z64#P&?6b43ER7M^QmIKTD=G{?=7YZFRXe4p{31O24ho(l4`>ey zZ(Kbj8lO&GHyW-D*g2z8n#G>JIZP@ScBQ1ReQ9ONx``*;#98bO5cT}fVvpeia5lmRI;ebaMIR` zqwgaLw552}cE{NizO7`bN&oPFunQsJe}IGNSCcdWCNNu ziWBknO7h*jTx*~XTX*7>)$+%xR3jlqJ8SJ`}dO#Jl~|8T!#n#9eMKI za6c_P6hEL7-SU)dSC_-2UwtRC&Z8ajcA9GB2vt!XVzj>pS6?`qz!3 z!mNk(Qn^=R@ODG@+r%~}k8TFyU8o<6_RNG#N z7NnRIQbq3mD6Wd89S;a{NB58-27b$sX8Id)VMTv7gPCtQEz$WbC8p43cL9hP>G$Eh z0b&ARnJ@y+ut`~RU{Z>v@$fwm*Y5Q2*eRCr`z@LKNy@cYukpmClV2Mff)aK4(pvUp zG3+g)xwGa6pvaSMIiGU}NbYJ|=)Lhc5^y-+>02-x5|6@Wg-EW111PKe%}` zKRyTD0&UR*dH6)j3n+EX)V`$EcV*OX?Mm1iWPM5f3Iy8hLo%&BgdgNd%1IR4F?O(h zeSys~9*~epRvSdz~yMgVfNYS7*;SxEbU&^;X8JC{B0wxxfSH zP^dMR>-6s8+i!CxeAZC;+Dbv%B64)^(RymQ@$CdQ4}(wY)i7FPVR<{sf_QAEy{9sT zYNw(dcE)e~5jeEfbD~w5*~iSAZn??`Z09>T^!pLnPHJmwcA#R!Z@i83l_b$)1hVhe z1YY0%cALxrE4bde>y+cOFUla5SXi1;47%`*zJMP&%*Y)@n-$Deq8}wa$|sT3w1Px7 zs1xb4!d>&j59GS1@ivI(l(-}O&3lINBVXkhl2w3(%QZH z@g0A;7QeOHF}%o$(TbiXiC9{nM4;K~!F01I<4Udu)x>4}8uuQEcSBt=BX%+G-qt2) zisz&q{0iB>8Qw00cWPgOWCz-0_y!K*OaSHuify-~CsR*(Y*Gpw=A zIle=A8d>o$KAqiy&z59N#WKu$^}Pryoc<@RpuJQH#Kw~cw^>e>av8s}{JG`?S%Pi& z{OC)77Dl2xlG_36+5V7e^Hye)MpMwLgZje*-DwG@A!d7yy9x{e+U+0}$b(Kp`2mDV z_CL?sxA*R6 zR>l;89pC&_en+*|>SPD?3e+G_-p}udK--54dQqt_PHeMBJ1_-I)Ix$m+~s);jR-5u zOz;t?L;>{$V=4?`d(fh=B8-C5DDK)?4O)G$X$@c1Y8V#g6y@W>@pxU-q3~>mjNd^# zih*pug^mjCS9acpW-YV;MN3%$d-P$EX|-{%GS<>hzcN$8aI=e4bLLeqRJ`#(rk@dW z!)|7cWl@oddwUQx=SK3yjjCrIt8fl$eiw!f#-NyaBcde_6`x_9B*%?Hz1C|y9O74D zc{+bKV!)|@Y~?Z_cGDgFbqdJ5Gj0z*Hy-8_VfY4YIyb;mck?^`#Iy6lZ9gUw1|T0*;fFBQRyS& zW2xQn(9IPqp4MO!6`mb4ra35l*3w7a!E5*&EArYW@aM@maZJ71O62A#4D-RHunqz+ z;!M3!Cl-Sj7-eIgX{KyAqubkVtHf^vmtd_Xb!iX@CqSGl+Fgt-AAXoO*G9e3By=9#} zc2W*Mb`i#Cuy$gql_d{Wi+i92;dn$upHB{0ve8g>vR`g6(HE6b*-LASEI(AqW_LqN zM84jkjAd58VOkG91L{J#fSHCDriK|dgH?ZEak{a68&2`x7Ye!#Y>=SG01Jnfd1UpV zdVJ1pitm5Ezw&z^&p3kOVH#@(;i1O`4mtN!o%_QqOy6J6t3fL$x8Y1Y-xHgC8*CP! z1Ndx%yCH^i@40bPXlk1O=T8uXezNaml$9_yN<>y+xorKl)avVHN}VR8i%{9Ug|)i_ z0Aq2w41=v~KJE2|L0u=_cm5>Pqu?^$X{`q+I8rC9Rd1-=f7H&9>VEO+CzW*5FDRx2 zsf<_Q6l7mj0Ha}`*GH)@O2u$OXZ&>~lZ0#j71KJ2gdcWl4Gw;=^05S#z6^FkpsnTsnx^h3FN|BZrW17R*Rz&0N3snJWC5&9^_&M;E;V&`FI0#uHnz@ zEGrZQ6=?eoiqk*Q$SRC5=iq?+I&)GfXMr*RMuLaA7-VF%PX&U~F@>pPJcZgZ zkZMR(pm48NC4SsHxAXX{h0$*3`zy*P9BC1U77LS2*a3`2cQY2RnC;S&qfJyU*~NUq z$^);gZ}7?E)-BY(*_K$El8B04-8t4rhPjFASYgr@fv#ZDX=-v(t!M>I6433HYD$ZP4P%B zK~OjW$nzwytnVphJ7 z2$(;tWHLS5_3~2vJr`-)@owJl>)$;uX+F-MSn_Dg4F6EJ|8Cl++cazSqet`~ox?WQ zisDol(xp@b@u{h%pNp@3l|1!*7*}TaYoPgfO5@6;)n>i1VawZn)%ruum1N?2nc7Z2 zFURN?PFd$Wf2^G8skRu~5t;5k$hQs|KkzWyThQ2U%NX;J1OMWcUf&- zRgck-z`j<*qs2k}-Oi+;wrG5jF1~4JlhL?H*Uad6a4a=R1Dp^Ln*LHoE?Q>dN-E`g@1_X~c7H^1{rhA(_*u617f4f+( zYHEvHztvLzk;879)85eaZ>zqvo15pVUo5^Nvm`2Xk;IB|SdqaI(9&Gm?^g8s)44VJ zSa5k#tp(G47G?YHig-bxbfdPQ#%0Z?1O4Ac10QR@3XBaNl@<#>v2!(dMMR^i?)?s* z3KokH3&Fj@L}!J-O`kULQH|FjUVI@#57?McrTGc#_wD4!# ztQYed^WbE2%fxdy+xiAW4D+RL6IQ{C@fTAVj=~l=5@f>~O!+GDepL(KMd=$A%KL)M zuNU27Q-3`i?4tXjU*+ket=D-aMV2DZ9FIqM@djYmRmOC8^@SeCCH-MqY&sbGwEnVX zJgKjQM(~1@X2tqU$&J5MM2Lx{$s0KO@&=tY%gDLjDL4g+^Ci4by+xbdhjp(M2(nwj}q^Rdey$gw~yy| zyt|k6f85I*-B^6%fm_w9FlJPa3zL~9o$tFkeLnF=n8yme=d1zQ zymu#CeNt9cXM;KIW}g>F-`v%{@-uz)Zc?AQ+xq*LgNY@$`G>7j!V4*#3{xo{_y}dh zcB~InWzxs>r7H99e^;WK6|$!r zzu30UK-aOgk><5iwOS!?Wi?aWt+g!k?l;Chb4k6c33pYK9i+n&GETVl=~S2xEGqYl zML7G2@{9CUR2t;f6G}+uO=eX+$=r#3=d`pYc(EcnZT#e*Tb_@Lo9$~Fzr&A}zB@a3 zGF=r5>E-mXVb(1-%U3t#yZU@7p^`tb=3)@o{L^fb$ZFz=i@i))jI6n zzu3L_!73}pXU!@rda-qz4v%shK3#B)*s`8m;H*s#!<{vIQvU-EL*SSn%tg{(kbZ)^rzpj=4_Lk1&Txl)ow=wR8XQM`G)PAP)CI-nP>5 z)YJ$Q?@px!`BC+2{o>K}3Bwyw9zx^tT}7*DshAZTZ1qEWx|9j$#hTEzPR$MozvBc&emfoj#Ag%>M^o{4-018#zbWrcRus2?Ks?6 z6LcTciJR8z`@ZA)E^7Es!$ra?HPtw|OZtqdoT);V1}6;ksCOh(ZYa@7_}tE!9>5~* z!z@(pl8?&2yu*@b>bt`AaZq}MA*4Qbz&ngd%%`Z;hjl=zjk#W|E%Tb=De>n@d|9Uh z>3!>)47-LL^V#*5pR=@;F<5)gN|P^_dDm@LY)fu6NbeW^HB%Q%CFoMvyRx>qp*U0N zq=#i(ug`D;yRV|xjp|y((}nU?mub(sL4%G(H~h`C^;yrj1tHzTp-H#tilORJk1==Y z5M70eU30l-fzx5*k{&N8sYlDH*E}ir7x-zI!zsST4Zmn@O&b85(_k58mZLYDV5Kp0ija z^sU2TsJElIcXD$#cC89`pAlQkH_m`LAL%5KdE&CJbNW@k^iO%Tn=vVY zCIVBHF|S=_@O`$;?sinRN7;E-F36MjY8ViRk}bN2UK1ksotn5dyk@*?? z+U56&BgHn#OH)1Ewt=n$q}U5XE3;q2m3XrDJ~~{Sl)Si79sSHJ=&%SwndGn_&nIf8 z3YQSahjh|f>?Co3@$iE+6?4@R9$vmdL2Ls-E++^e9MW0yG4>KMwJEZT}Ye6SVqatcCM-4xO?H-oH|j4Tg{HX zr;DBaYFcFcVNpQPOGdex;Quv!uEk1w^_&RGBRZ8JoENq4`g6yN#bxzVT6 zU%!EEjrSbqcUK2r`F_%VzcUjsxh&W&tm5-g>_ldT&`oJ`o8|J{O6BXjpGZ7?a=q^L zpEl0?w|2b?)?})jVL#>bytHLsZRt5P*VWP$hZpn<>Hj~b!}d_qg0oh-_v?*JUNdD+Im9kWkPF8V1TSnDe_w8<5{PbNEF>{DR5CD;r%}t}m=# z-*};V;^SW>dWUnnzU(R}x8t|k8uqkpHgNpzufd&txRL zklA5%F50B4w>6Icop7AL>ZzXU$@z=w?zXBO=_w2g2`1hHz@82idN$(NAxb>0elJnNvm8#gPH~am+^IBbTeHHp&+I7ta{}1Vm7o2XUHa#Ji)m){8-8qWm|a_ZVSC!H{`p?(OON>k zr|eWb!IbyNLeBle;&v9j-vXx!*SLPS?5mz;DEm)0{or@m=ZdH9cQz|0Ue9%zaOTz1 z8lJvfla)#bZ_B=p%=@xAnXR<%Z(huaLgCUk-*uL!$uwVzzqBUh^X{%6y?u|PGNN3+ zSvGCG@cwe4OvLoZJ~lgz7OB12Z5qzA!e{07r!VaEoUh-P;1^u}^>M`9dh@u;?LEqY zi81Yh^Nq!K)a`nFt9Vyk!CI4p$!Di4_x>rD{JEFW(OLBPz8{}ze|?tXsO|2!zvJ`w zrra6(rve*Z$A7*FyZN#5#(Tpra>{tM^qq zJ=Qu_p-}Xu`0=UVH5U2vTAroVcPWKil-=QuWe)s&FZtf~(wSO)FTH4)`u&84zk6J!s~x!eCH+CBU7*C2dR|@g*YkA>xit2e3rIS>FI`tV zS5VNEwY%4K`n7``^G&<9&xo3Gs{iIqmlQ*w5>4IL^VfANrC z + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + + geom_boxplot(fill = "#91CBD765", alpha = 0.4) + } + + p + + theme(legend.position = "none") + + labs( + x = metric_lab, + y = NULL, + fill = NULL, + color = NULL + ) +} + +set.seed(1805) +pdp_age <- model_profile(explainer_rf, N = 500, variables = "Year_Built") + +ggplot_pdp <- function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`), linewidth = 1.2, alpha = 0.8) + } else { + p <- p + geom_line(color = "midnightblue", linewidth = 1.2, alpha = 0.8) + } + + + p +} + +set.seed(1806) + +pdp_liv <- + model_profile( + explainer_rf, + N = 1000, + variables = "Gr_Liv_Area", + groups = "Bldg_Type" +) + +plot1 <- + ggplot_pdp(pdp_liv, Gr_Liv_Area) + + scale_x_log10() + + scale_color_brewer(palette = "Dark2") + + labs(x = "Gross living area", + y = "Sale Price (log)", + color = NULL) + +plot2 <- + as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) + + geom_line( + linewidth = 1.2, + alpha = 0.8, + show.legend = FALSE + ) + + scale_x_log10() + + facet_wrap(~Bldg_Type) + + scale_color_brewer(palette = "Dark2") + + labs(x = "Gross living area", + y = "Sale Price (log)", + color = NULL) + ``` ```{r copy-code-chunk, child = system.file("child_documents/copy_button.Rmd", package = "tutorial.helpers")} @@ -121,7 +256,8 @@ set.seed(1802) ## Introduction ### - +This tutorial covers [Chapter 18: Explaining Models and Predictions](https://www.tmwr.org/explain) from [*Tidy Modeling with R*](https://www.tmwr.org/) by Max Kuhn and Julia Silge. In this tutorial, you will learn how to create model explainers with the use of `explain_tidymodels()`, local explanations with the use of `predict_parts()`, global explanations with the use of `model_parts()` and a user-created function, and building global explanations from local explanations. The packages used in this tutorial include [**tidymodels**](https://www.tidymodels.org/), [**DALEXtra**](https://modeloriented.github.io/DALEXtra/), and [**forcats**](https://forcats.tidyverse.org/). + ## Software for Model Explanations ### @@ -1328,6 +1464,40 @@ predict_parts( ### +Comparing this output to the `duplex`, the mean for the `big_house` is a positive number, while the `duplex` had a negative mean. + +### Exercise 27 + +Copy the previous code and assign it to a new variable named `shap_house`. + +```{r local-explanations-27, exercise = TRUE} + +``` + + + +```{r local-explanations-27-hint-1, eval = FALSE} +... <- + predict_parts( + explainer = explainer_rf, + new_observation = big_house, + type = "shap", + B = 20 + ) +``` + +```{r include = FALSE} +shap_house <- + predict_parts( + explainer = explainer_rf, + new_observation = big_house, + type = "shap", + B = 20 + ) +``` + +### + The results are shown in the graph below; unlike the duplex, the size and age of this house contribute to its price being higher: ```{r} @@ -1343,10 +1513,3164 @@ Congrats! You have learned how to use `predict_parts()`, which computes how cont Global model explanations, also called global feature importance or variable importance, help us understand which features are most important in driving the predictions of the linear and random forest models overall, aggregated over the whole training set. -## Summary +### Exercise 1 + +Type in `set.seed()` and pass in `1803`. + +```{r global-explanations-1, exercise = TRUE} + +``` + +```{r global-explanations-1-hint-1, eval = FALSE} +set.seed(...) +``` + +```{r include = FALSE} +set.seed(1803) +``` + +### + +One way to compute variable importance is to *permute* the features. You can permute or shuffle the values of a feature, predict from the model, and then measure how much worse the model fits the data compared to before shuffling. + +### Exercise 2 + +If shuffling a column causes a large degradation in model performance, it is important; if shuffling a column’s values doesn’t make much difference to how the model performs, it must not be an important variable. This approach can be applied to any kind of model (it is model agnostic), and the results are straightforward to understand. + +Let's compute this kind of variable importance. In the code chunk below, type in `model_parts()`. Inside this funciton, type in `explainer_lm` as the first argument and set `loss_function` to `loss_root_mean_square`. + +```{r global-explanations-2, exercise = TRUE} + +``` + +```{r global-explanations-2-hint-1, eval = FALSE} +model_parts(..., loss_function = ...) +``` + +```{r include = FALSE} +model_parts(explainer_lm, loss_function = loss_root_mean_square) +``` + +### + +`model_parts()` is used to compute the feature importance or contributions of different features in a given model's predictions. + +`loss_root_mean_square` is used to calculate the RMSE, or the Root Mean Square Error. RMSE measures the accuracy of a predictive model's performance (lower = better). + +### Exercise 3 + +Copy the previous code and assign it to a new variable named `vip_lm`. + +```{r global-explanations-3, exercise = TRUE} + +``` + + + +```{r global-explanations-3-hint-1, eval = FALSE} +... <- model_parts(explainer_lm, loss_function = loss_root_mean_square) +``` + +```{r include = FALSE} +vip_lm <- model_parts(explainer_lm, loss_function = loss_root_mean_square) +``` + +### + +Let's look at the output for this code: + +```` +variable mean_dropout_loss label +1 _full_model_ 0.07484518 lm + interactions +2 Bldg_Type 0.08397234 lm + interactions +3 Latitude 0.09252911 lm + interactions +4 Longitude 0.09728897 lm + interactions +5 Year_Built 0.10598431 lm + interactions +6 Neighborhood 0.13051164 lm + interactions +7 Gr_Liv_Area 0.14083319 lm + interactions +8 _baseline_ 0.23691334 lm + interactions +```` + +The `variable` column represents all of the contributors in the linear model explainer. The `mean_droupout`loss` column represents the calculated RMSE for each of the predictors. As you can see, this column is ranked from the lowest RMSE (meaning better predictive performance) to the highest RMSE (worse predictive performance). + +### Exercise 4 + +Type in `set.seed()` and pass in `1804`. + +```{r global-explanations-4, exercise = TRUE} + +``` + +```{r global-explanations-4-hint-1, eval = FALSE} +set.seed(...) +``` + +```{r include = FALSE} +set.seed(1804) +``` + +### + +Both the `model_parts()` and `loss_root_mean_square` function come from the **DALEX** package. + +### Exercise 5 + +In the code chunk below, type in `model_parts()`. Inside this function, type in `explainer_rf` as the first argument and set `loss_function` to `loss_root_mean_square` as the second argument. + +```{r global-explanations-5, exercise = TRUE} + +``` + +```{r global-explanations-5-hint-1, eval = FALSE} +model_parts(..., loss_function = ...) +``` + +```{r include = FALSE} +model_parts(explainer_rf, loss_function = loss_root_mean_square) +``` + +### + +Comparing the output with `explainer_lm`, both of these explainer have a low `_full_model_` mean drouput loss and high `_baseline_` mean drouput loss. + +### Exercise 6 + +Copy the previous code and assign it to a new variable named `vip_rf`. + +```{r global-explanations-6, exercise = TRUE} + +``` + + + +```{r global-explanations-6-hint-1, eval = FALSE} +... <- model_parts(explainer_rf, loss_function = loss_root_mean_square) +``` + +```{r include = FALSE} +vip_rf <- model_parts(explainer_rf, loss_function = loss_root_mean_square) +``` + +### + +There are a series of `loss` functions in the **DALEX** package. Type `?loss_root_mean_square()` in the Console to learn more about them. + +### Exercise 7 + +The default plot method from DALEX could be used here by calling `plot(vip_lm, vip_rf)` but the underlying data is available for exploration, analysis, and plotting. Let’s create a function for plotting. + +In the code chunk below, type in `function(...){}`. Then, inside the function, create a variable named `obj` and assign it to `list(...)`. + +```{r global-explanations-7, exercise = TRUE} + +``` + +```{r global-explanations-7-hint-1, eval = FALSE} +function(...) { + ... <- list(...) +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) +} +``` + +### + +Chapter [24](https://r4ds.hadley.nz/rectangling.html#lists) of the [*R for Data Science*] textbook goes over the functionality of lists and its hierarchy. + +### Exercise 8 + +Copy the previous code. On a new line, create a variable named `metric_name` and assign it to `attr()`. Inside `attr()`, type in `obj[[1]]` as the first argument and `"loss_name"` as the second argument. + +```{r global-explanations-8, exercise = TRUE} + +``` + + + +```{r global-explanations-8-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- ...(obj[[1]], "...") +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") +} +``` + +### + +This code is extracting the `"loss_name"` attribute (through the use of `attr()`) from the object in the `obj` list. + +### Exercise 9 + +Copy the previous code. On a new line, create a new variable named `metric_lab` and assign it to `paste()`. Inside `paste()`, set `metric_name` as the first argument and `"after permutations\n(higher indicates more important)"` as the second argument. + +```{r global-explanations-9, exercise = TRUE} + +``` + + + +```{r global-explanations-9-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- ...(..., "after permutations\n(higher indicates more important)") +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") +} +``` + +### + +`paste()` is a function that concatenates (or combines) strings. In this case, the `metric_name` is being concatenated with `"after permutations\n(higher indicates more important)"`. Also, `\n` indicates that a new line should be formed within the string. + +### Exercise 10 + +Copy the previous code. On a new line, create a new variable named `full_vip` and assign it to `bind_rows(obj)`. Then, pipe the bind rows function to `filter()`. Inside `filter()`, type in `variable != "_baseline_"`. + +```{r global-explanations-10, exercise = TRUE} + +``` + + + +```{r global-explanations-10-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + ... <- bind_rows(...) |> + filter(variable != "...") +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") +} +``` + +### + +This code is binding the rows of `obj` together and filtering the data so that the `_baseline_` variable isn't there. + +### Exercise 11 + +Copy the previous code. On a new line, create a new variable named `perm_vals` and assign it to `full_vip`. Then, pipe `full_vip` to `filter()`. Inside `filter()`, type in `(variable == "_full_model_")`. + +```{r global-explanations-11, exercise = TRUE} + +``` + + + +```{r global-explanations-11-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- ... |> + filter(variable == "...") +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") +} +``` + +### + +This code is making sure that the `_full_model_` variable is not included in the permute values. + +### Exercise 12 + +Copy the previous code and pipe `filter(variable == "_full_model_")` to `summarise()`. Inside `summarise()`, set `dropout_loss` to `mean(dropout_loss)` and set `.by` to `label`. + +```{r global-explanations-12, exercise = TRUE} + +``` + + + +```{r global-explanations-12-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(...), .by = ...) +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) +} +``` + +### + +As a reminder, the `.by` argument inside `summarise()` can be used to replace the `group_by()` function (for most cases). + +### Exercise 13 + +Copy the previous code. On a new line, create a new variable named `p` and assign it to `full_vip`. Then, pipe `full_vip` to `filter()`. Inside `filter()`, type in `variable != "_full_model_"`. + +```{r global-explanations-13, exercise = TRUE} + +``` + + + +```{r global-explanations-13-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- ... |> + filter(variable != "...") +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") +} +``` + ### - +Feature importance can aid in dimensionality reduction (discussed in the "Dimensionaity Reduction" tutorial). By identifying less important features, you can potentially reduce the complexity of your model and improve its generalization. + +### Exercise 14 + +Copy the previous code. Pipe `filter(variable != "_full_model_")` to `mutate()`. Inside `mutate()`, set `variable` to `fct_reorder(variable, dropout_loss)`. + +```{r global-explanations-14, exercise = TRUE} + +``` + + + +```{r global-explanations-14-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(... = fct_reorder(variable, ...)) +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) +} +``` + +### + +As a reminder, `fct_reorder()` is a function used to reorder the levels of a factor variable based on the values of another variable. + +### Exercise 15 + +Copy the previous code and pipe `mutate(variable = fct_reorder(variable, dropout_loss))` to `ggplot()`. Inside this function, using `aes()`, set `x` to `dropout_loss` and `y` to `variable`. + +```{r global-explanations-15, exercise = TRUE} + +``` + + + +```{r global-explanations-15-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = ..., y = ...)) +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) +} +``` + +### + +`plot()` is a base R function that can be used to create graphs. In this scenario, this function could've been used, but as mentioned earlier, the underlying data is available for exploration, analysis, and plotting. Visit Chapter [28](https://r4ds.hadley.nz/base-r#plots) of the [*R for Data Science*](https://r4ds.hadley.nz/) textbook to learn more about this function. + +### Exercise 16 + +Copy the previous code. Now, lets create an `if` statement. On a new line, type in `if(length(obj) > 1) {}`. Inside the curly brackets, create a variable named `p` and assign it to `p + facet_wrap(vars(label))`. + +```{r global-explanations-16, exercise = TRUE} + +``` + + + +```{r global-explanations-16-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(...) > 1) { + p <- ... + + facet_wrap(vars(...)) + } +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + } +} +``` + +### + +`if` and `else` statements are used to perform different actions based on conditions. Looking at the code above, the code under the `if` statement will run *only if* the length of `obj` is greater than `1`. If not, then the `else` statement will run (you will create an else statement later). + +### Exercise 17 + +Copy the previous code. Add `geom_vline()` after `facet_wrap(vars(label))` using the `+` operator. Inside `geom_vline()`, set `data` to `perm_vals`. + +```{r global-explanations-17, exercise = TRUE} + +``` + + + +```{r global-explanations-17-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = ... + ) + } +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals + ) + } +} +``` + +### + +`geom_vline()` is a function that adds a vertical line (along the x-axis) to a plot, creating vertical reference lines or highlight specific values. + +### Exercise 18 + +Copy the previous code. Inside `geom_vline()`, using the `aes()` function, set `xintercept` to `dropout_loss` and `color` to `label`. + +```{r global-explanations-18, exercise = TRUE} + +``` + + + +```{r global-explanations-18-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = ..., color = ...) + ) + } +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label) + ) + } +} +``` + +### + +Click [here](https://ggplot2.tidyverse.org/reference/geom_abline.html) to learn about the other reference line functions included in the **ggplot2** package. + +### Exercise 19 + +Copy the previous code. Within `geom_vline()`, but outside of the `aes()` function, set `linewidth` to `1.4`, `lty` to `2`, and `alpha` to `0.7`. + +```{r global-explanations-19, exercise = TRUE} + +``` + + + +```{r global-explanations-19-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = ..., + lty = ..., + alpha = ... + ) + } +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + } +} +``` + +### + +Understanding feature importance has real-world implications. It helps stakeholders make informed decisions, prioritize efforts, and allocate resources effectively based on the insights gained. + +### Exercise 20 + +Copy the previous code and add `geom_boxplot()` using the `+` operator. Inside this function, using `aes()`, set `color` to `label` and `fill` to `label`. Then, within `geom_boxplot()` but outside the `aes()` function, set `alpha` to `0.2`. + +```{r global-explanations-20, exercise = TRUE} + +``` + + + +```{r global-explanations-20-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = ..., fill = ...), alpha = ...) + } +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } +} +``` + +### + +You have used `geom_boxplot()` earlier in this tutorial to display the distribution of contributions in `shap_duplex`. + +### Exercise 21 + +Copy the previous code. Locate the end curly brakcet `}` of the `if` statement. On the same line as that bracket, type in `else{}`. + +```{r global-explanations-21, exercise = TRUE} + +``` + + + +```{r global-explanations-21-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + + } +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + + } +} +``` + +### + +As mentioned before, an `if` statement is usually accompanied by an `else` statement; if the condition in the `if` statement is `FALSE`, then the code goes to the `else` statement and runs any code inside that statement. + +### Exercise 22 + +Copy the previous code. Inside the `else` statement, create a variable named `p` and assign it to `p + geom_vline()`. + +```{r global-explanations-22, exercise = TRUE} + +``` + + + +```{r global-explanations-22-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- ... + + geom_vline( + + ) + } +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + + ) + } +} +``` + +### + +This diagram shows the functionality of if and else statements: + +```{r} +knitr::include_graphics("images/pic3.png") +``` + +### Exercise 23 + +Copy the previous code. Inside `geom_vline()`, set `data` to `perm_vals`, `linewidth` to `1.4`, `lty` to `2`, and `alpha` to `0.7`. Then, using the `aes()` function, set `xintercept` to `dropout_loss`. + +```{r global-explanations-23, exercise = TRUE} + +``` + + + +```{r global-explanations-23-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = ..., + linewidth = ..., + lty = 2, + alpha = ..., + aes(xintercept = ...) + ) + } +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + } +} +``` + +### + +As a reminder, it is always a good idea to read the associated chapter for each tutorial you do. The associated chapter for this tutorial is [here](https://www.tmwr.org/explain). + +### Exercise 24 + +Copy the previous code and add `geom_boxplot()` using the `+` operator. Inside `geom_boxplot()`, set `fill` to `"#91CBD765"` and `alpha` to `0.4`. + +```{r global-explanations-24, exercise = TRUE} + +``` + + + +```{r global-explanations-24-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + + geom_boxplot(fill = "...", alpha = ...) + } +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + + geom_boxplot(fill = "#91CBD765", alpha = 0.4) + } +} +``` + +### + +`#91CBD765` is a hexadecimal color code. This is another way of passing in a color in R. Here are some other hexadecimal color codes you can use: + +Dark Red: `"#8B0000"` +Royal Blue: `"#4169E1"` +Lime Green: `"#32CD32"` +Gold: `"#FFD700"` +Hot Pink: `"#FF69B4"` +Silver: `"#C0C0C0"` +Maroon: `"#800000"` +Chocolate: `"#D2691E"` + +### Exercise 25 + +Copy the previous code. Outside of the `else` statement, but inside the entire function structure, type `p + theme()`. Inside of `theme()`, set `legend.position` to `"none"`. + +```{r global-explanations-25, exercise = TRUE} + +``` + + + +```{r global-explanations-25-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + + geom_boxplot(fill = "#91CBD765", alpha = 0.4) + } + + ... + + theme(legend.position = "...") +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + + geom_boxplot(fill = "#91CBD765", alpha = 0.4) + } + + p + + theme(legend.position = "none") +} +``` + +### + +A big difference between the code under the `if` statement and the code under the `else` statement is the `facet_wrap()` function. If the length of the object is greater than 1, then a facet wrap is performed. Otherwise, the code goes straight to creating a vline. + +### Exercise 26 + +Copy the previous code. After the `theme` function, add `labs()` using the `+` operator. Inside this function, set `x` to `metric_lab`, `y` to `NULL`, `fill` to `NULL`, and `color` to `NULL`. + +```{r global-explanations-26, exercise = TRUE} + +``` + + + +```{r global-explanations-26-hint-1, eval = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + + geom_boxplot(fill = "#91CBD765", alpha = 0.4) + } + + p + + theme(legend.position = "none") + + labs( + x = metric_lab, + y = ..., + ... = NULL, + color = ... + ) +} +``` + +```{r include = FALSE} +function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + + geom_boxplot(fill = "#91CBD765", alpha = 0.4) + } + + p + + theme(legend.position = "none") + + labs( + x = metric_lab, + y = NULL, + fill = NULL, + color = NULL + ) +} +``` + +### + +Check out the help page of `labs()` to find out more about its arguments. + +### Exercise 27 + +Copy the previous code and assign the entire function to a new variable named `ggplot_imp`. + +```{r global-explanations-27, exercise = TRUE} + +``` + + + +```{r global-explanations-27-hint-1, eval = FALSE} +... <- function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + + geom_boxplot(fill = "#91CBD765", alpha = 0.4) + } + + p + + theme(legend.position = "none") + + labs( + x = metric_lab, + y = NULL, + fill = NULL, + color = NULL + ) +} +``` + +```{r include = FALSE} +ggplot_imp <- function(...) { + obj <- list(...) + metric_name <- attr(obj[[1]], "loss_name") + metric_lab <- paste(metric_name, "after permutations\n(higher indicates more important)") + + full_vip <- bind_rows(obj) |> + filter(variable != "_baseline_") + + perm_vals <- full_vip |> + filter(variable == "_full_model_") |> + summarise(dropout_loss = mean(dropout_loss), .by = label) + + p <- full_vip |> + filter(variable != "_full_model_") |> + mutate(variable = fct_reorder(variable, dropout_loss)) |> + ggplot(aes(x = dropout_loss, y = variable)) + + if(length(obj) > 1) { + p <- p + + facet_wrap(vars(label)) + + geom_vline( + data = perm_vals, + aes(xintercept = dropout_loss, color = label), + linewidth = 1.4, + lty = 2, + alpha = 0.7 + ) + + geom_boxplot(aes(color = label, fill = label), alpha = 0.2) + } else { + p <- p + + geom_vline( + data = perm_vals, + linewidth = 1.4, + lty = 2, + alpha = 0.7, + aes(xintercept = dropout_loss) + ) + + geom_boxplot(fill = "#91CBD765", alpha = 0.4) + } + + p + + theme(legend.position = "none") + + labs( + x = metric_lab, + y = NULL, + fill = NULL, + color = NULL + ) +} +``` + +### + +Overall, this function generates a visual representation of the RMSE of the contributors after permutations. + +### Exercise 28 + +Now, let's use this function and generate a graph. In the code chunk below, type in `ggplot_imp()`. Inside this function, type in `vip_lm` as the first argument and `vip_rf` as the second argument. + +```{r global-explanations-28, exercise = TRUE} + +``` + +```{r global-explanations-28-hint-1, eval = FALSE} +ggplot_imp(..., vip_rf) +``` + +```{r include = FALSE} +ggplot_imp(vip_lm, vip_rf) +``` + +### + +The dashed line in each panel shows the RMSE for the full model, either the linear model or the random forest model. Features farther to the right are more important, because permuting them results in higher RMSE. + +There is quite a lot of interesting information to learn from this plot; for example, neighborhood is quite important in the linear model with interactions/splines but the second least important feature for the random forest model + +### + +Congrats! You have learned the process of determining which features are most important in driving the predictions of a model. + +## Building Global Explanations From Local Explanations +### + +So far, this tutorial has focused on local model explanations for a single observation (via Shapley additive explanations) and global model explanations for a data set as a whole (via permuting features). It is also possible to build global model explanations by aggregating local model explanations, as with partial dependence profiles. + +### Exercise 1 + +In the code chunk below, type in `set.seed()` and pass in `1805`. + +```{r building-global-expl-1, exercise = TRUE} + +``` + +```{r building-global-expl-1-hint-1, eval = FALSE} +set.seed(...) +``` + +```{r include = FALSE} +set.seed(1805) +``` + +### + +Partial dependence profiles show how the expected value of a model prediction, like the predicted price of a home in Ames, changes as a function of a feature, like the age or gross living area. + +### Exercise 2 + +One way to build such a profile is by aggregating or averaging profiles for individual observations. A profile showing how an individual observation’s prediction changes as a function of a given feature is called an ICE (individual conditional expectation) profile or a CP (*ceteris paribus*) profile. These kind of individual profiles can be computed (for 500 of the observations in our training set) and then aggregated them using the **DALEX** function `model_profile()` + +In the code chunk below, type in `model_profile()`. Inside this function, type in `explainer_rf` as the first argument, set `N` to `500` as the second argument, and set `variables` to `"Year_Built"` as the third argument. + +```{r building-global-expl-2, exercise = TRUE} + +``` + +```{r building-global-expl-2-hint-1, eval = FALSE} +model_profile(..., N = ..., variables = "Year_Built") +``` + +```{r include = FALSE} +model_profile(explainer_rf, N = 500, variables = "Year_Built") +``` + +### + +`model_profile()` calculates explanations on a data set level set that explore model response as a function of selected variables. + +### Exercise 3 + +Copy the previous code and assign it to a new variable named `pdp_age`. + +```{r building-global-expl-3, exercise = TRUE} + +``` + + + +```{r building-global-expl-3-hint-1, eval = FALSE} +... <- model_profile(explainer_rf, N = 500, variables = "Year_Built") +``` + +```{r include = FALSE} +pdp_age <- model_profile(explainer_rf, N = 500, variables = "Year_Built") +``` + +### + +Looking at the output of the code, `_yhat_` is one of the columns. This columns contains the estimated values of the data. + +### Exercise 4 + +Just like before, let's create a function for plotting the underlying data in this object. In the code chunk below, type in `function(obj, x){}`. + +```{r building-global-expl-4, exercise = TRUE} + +``` + +```{r building-global-expl-4-hint-1, eval = FALSE} +function(..., x){ + +} +``` + +```{r include = FALSE} +function(obj, x){ + +} +``` + +### + +As you can see from the function's parameters, this function is taking in an object, represented by `obj`, and a variable, represented by `x`. + +### Exercise 5 + +Copy the previous code. Inside the body of the function, create a new variable, `p`, and assign it to `as_tibble()`. Inside `as_tibble()`, type in `obj$agr_profiles` + +```{r building-global-expl-5, exercise = TRUE} + +``` + + + +```{r building-global-expl-5-hint-1, eval = FALSE} +function(obj, x){ + p <- + ...(obj$...) +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) +} +``` + +### + +`as_tibble()` is a function that coerces lists, matrices, and more to tibbles. + +### Exercise 6 + +Copy the previous code. Pipe the `as_tibble()` function to `mutate()`. Inside `mutate()`, set `"_label_"` (surrounded in backticks) to `stringr::str_remove(_label_, "^[^_]*_"))` (Note: make sure to encase `"_label"_` in backticks; otherwise the code won't work). + +```{r building-global-expl-6, exercise = TRUE} + +``` + + + +```{r building-global-expl-6-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + ...(`_label_` = stringr::...(`_label_`, "^[^_]*_")) +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) +} +``` + +### + +In this code, the `mutate()` function is being used to edit the `_label_` column. Inside this column, the pattern `"^[^_]*_"` is being removed. + +`"^[^_]*_"` stands for any sequence of characters that starts with any character other than an underscore (`_`) and ends with an underscore. + +### Exercise 7 + +Copy the previous code and pipe the `mutate()` function to `ggplot()`. Inside this function, using `aes()`, set `x` to `_x_` and `y` to `_yhat_` (Note: make sure to encase `_x_` and `_yhat_` with backticks; otherwise the code won't work). + +```{r building-global-expl-7, exercise = TRUE} + +``` + + + +```{r building-global-expl-7-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(...(x = `_x_`, ... = `_yhat_`)) +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) +} +``` + +### + +Here is the breakdown for `"^[^_]*_"`: + +- `^` anchors the pattern to the start of the string. It indicates that the following pattern should match from the beginning of the string. + +- `[^_]` is a character class that matches any character except an underscore (`_`). The `^` at the beginning of the character class negates the match. + +- `*` matches zero or more occurrences of the preceding pattern. In this case, it means matching zero or more characters that are not underscores. + +- `_` matches a literal underscore character. + +### Exercise 8 + +Copy the previous code and add `geom_line()` using the `+` operator. Inside `geom_line()`, set `data` to `as_tibble(obj$cp_profiles)` + +```{r building-global-expl-8, exercise = TRUE} + +``` + + + +```{r building-global-expl-8-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = ...(obj$...) + ) +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles) + ) + +} +``` + +### + +`geom_line()` is a function that creates line plots or line charts. + +### Exercise 9 + +Copy the previous code. Inside `geom_line()`, using `aes()`, set `x` to `{{ x }}` and `group` to `_ids_` (Note: Make sure to encase `_ids_` with backticks). + +```{r building-global-expl-9, exercise = TRUE} + +``` + + + +```{r building-global-expl-9-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(... = {{ x }}, ... = `_ids_`) + ) + +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`) + ) + +} +``` + +### + +The double curly braces allow you to perform non-standard evaluation (NSE) of the variable name within the **ggplot2** layer. + +### Exercise 10 + +Copy the previous code. Inside `geom_line()`, set `linewidth` to `0.5`, `alpha` to `0.05`, and `color` to `"gray50"`. + +```{r building-global-expl-10, exercise = TRUE} + +``` + + + +```{r building-global-expl-10-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = ..., + alpha = ..., + color = "..." + ) + +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + +} +``` + +### + +Here are some other colors that R provides: + +- `"lightblue"` +- `"lightsalmon"` +- `"lavender"` +- `"lightcoral"` + +### Exercise 11 + +Copy the previous code. Outside of `geom_line()`, but within the body of the function, on a new line, create a new variable named `num_colors` and assign it to `n_distinct()`. Inside this function, type in `obj$agr_profiles$_label_` (Note: Make sure to encase `_label_` in back ticks). + +```{r building-global-expl-11, exercise = TRUE} + +``` + + + +```{r building-global-expl-11-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + ... <- ...(obj$agr_profiles$`_label_`) + +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + +} +``` + +### + +`n_distinct()` counts the number of unique/distinct combinations in a set of one or more vectors. + +### Exercise 12 + +Copy the previous code. On a new line, let's create an `if` statement. Type in `if(){}`. Inside the parenthesis, type in `num_colors > 1`. + +```{r building-global-expl-12, exercise = TRUE} + +``` + + + +```{r building-global-expl-12-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (... > 1) { + + } + +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + + } + +} +``` + +### + +As a reminder, take a look at the diagram below, illustrating the idea of an if and else statement: + +```{r} +knitr::include_graphics("images/pic3.png") +``` + +### Exercise 13 + +Copy the previous code. Inside the `if` statement, create a variable named `p` and assign it to `p + geom_line()`. Then, inside `geom_line()`, using `aes()`, set `color` to `_label_` (Note: Make sure to encase `_label_` in backticks). + +```{r building-global-expl-13, exercise = TRUE} + +``` + + + +```{r building-global-expl-13-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + ...(aes(... = `_label_`)) + } + +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`)) + } + +} +``` + +### + +In R, backticks are used to handle variable or column names that might not be valid as identifiers in standard R syntax. This is the reason you are told to put backticks around certain column names. + +### Exercise 14 + +Copy the previous code. Inside `geom_line()`, but outside the `aes()` function, set `linewidth` to `1.2` and `alpha` to `0.8`. + +```{r building-global-expl-14, exercise = TRUE} + +``` + + + +```{r building-global-expl-14-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`), ... = 1.2, alpha = ...) + } + +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`), linewidth = 1.2, alpha = 0.8) + } + +} +``` + +### + +In this function, `p` stands for the plot that is being created. + +### Exercise 15 + +Copy the previous code and locate the end bracket (`}`) of the if statement. On the same line as this bracket, type in `else{}`. Then, inside the body of the `else` statement, create a variable named `p` and assign it to `p + geom_line()`. + +```{r building-global-expl-15, exercise = TRUE} + +``` + + + +```{r building-global-expl-15-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`), linewidth = 1.2, alpha = 0.8) + } else { + p <- p + ...() + } + +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`), linewidth = 1.2, alpha = 0.8) + } else { + p <- p + geom_line() + } + +} +``` + +### + +Along with `if` & `else` statements, there is also an `else-if` statement. This statement is an extension of the basic `if` statement that allows you to specify alternative conditions to check when the initial `if` condition is not met. + +### Exercise 16 + +Copy the previous code. Inside `geom_line()`, set `color` to `"midnightblue"`, `linewidth` to `1.2`, and `alpha` to `0.8`. + +Then, outside of the `else` statement, but inside the function, type in `p`. + +```{r building-global-expl-16, exercise = TRUE} + +``` + + + +```{r building-global-expl-16-hint-1, eval = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`), linewidth = 1.2, alpha = 0.8) + } else { + p <- p + geom_line(color = "...", linewidth = ..., alpha = ...) + } + + + p +} +``` + +```{r include = FALSE} +function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`), linewidth = 1.2, alpha = 0.8) + } else { + p <- p + geom_line(color = "midnightblue", linewidth = 1.2, alpha = 0.8) + } + + + p +} +``` + +### + +`p` is at the end of the function is because it is just a variable; it won't be used unless called upon. + +### Exercise 17 + +Copy the code and assign the entire function to a new variable named `ggplot_pdp`. + +```{r building-global-expl-17, exercise = TRUE} + +``` + + + +```{r building-global-expl-17-hint-1, eval = FALSE} +... <- function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`), linewidth = 1.2, alpha = 0.8) + } else { + p <- p + geom_line(color = "midnightblue", linewidth = 1.2, alpha = 0.8) + } + + + p +} +``` + +```{r include = FALSE} +ggplot_pdp <- function(obj, x){ + p <- + as_tibble(obj$agr_profiles) |> + mutate(`_label_` = stringr::str_remove(`_label_`, "^[^_]*_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`)) + + geom_line( + data = as_tibble(obj$cp_profiles), + aes(x = {{ x }}, group = `_ids_`), + linewidth = 0.5, + alpha = 0.05, + color = "gray50" + ) + + num_colors <- n_distinct(obj$agr_profiles$`_label_`) + + if (num_colors > 1) { + p <- p + geom_line(aes(color = `_label_`), linewidth = 1.2, alpha = 0.8) + } else { + p <- p + geom_line(color = "midnightblue", linewidth = 1.2, alpha = 0.8) + } + + + p +} +``` + +### + +As mentioned earlier this section, this function will be used to graph the underlying data. + +### Exercise 18 + +Now, let's use this function. In the code chunk below, type in `ggplot_pdp()`. Pass in `pdp_age` as the first argument and `Year_Built` as the second argument. Then, add your `labs()`. The final graph should look like this: + +```{r} +ggplot_pdp(pdp_age, Year_Built) + + labs(x = "Year built", + y = "Sale Price (log)", + color = NULL) +``` + +```{r building-global-expl-18, exercise = TRUE} + +``` + +```{r building-global-expl-18-hint-1, eval = FALSE} +ggplot_pdp(pdp_age, Year_Built) + + labs(x = "...", + y = "...", + color = ...) +``` + +```{r include = FALSE} +ggplot_pdp(pdp_age, Year_Built) + + labs(x = "Year built", + y = "Sale Price (log)", + color = NULL) +``` + +### + +Looking at the graph, sale price for houses built in different years is mostly flat, with a modest rise after about 1960. + +### Exercise 19 + +Type in `set.seed()` and pass in `1806`. + +```{r building-global-expl-19, exercise = TRUE} + +``` + +```{r building-global-expl-19-hint-1, eval = FALSE} +set.seed(...) +``` + +```{r include = FALSE} +set.seed(1806) +``` + +### + +Partial dependence profiles can be computed for any other feature in the model, and also for groups in the data, such as `Bldg_Type`. + +### Exercise 20 + +Let’s use 1,000 observations for these profiles. In the code chunk below, type in `model_profile()`. Inside this function, type in `explainer_rf` as the first argument, set `N` to `1000` as the second argument, set `variables` to `"Gr_Liv_Area"` as the third argument, and set `groups` to `"Bldg_Type"` as the fourth argument. + +(Note: You will get a warning) + +```{r building-global-expl-20, exercise = TRUE} + +``` + +```{r building-global-expl-20-hint-1, eval = FALSE} +model_profile( + explainer_rf, + N = ..., + ... = "Gr_Liv_Area", + groups = "..." +) +``` + +```{r include = FALSE} +model_profile( + explainer_rf, + N = 1000, + variables = "Gr_Liv_Area", + groups = "Bldg_Type" +) +``` + +### + +As you can see, a warning message pops up, saying that all of the 201 unique values will be used as variable splits. For now, ignore this warning and move on. + +### Exercise 21 + +Copy the previous code and assign it to a new variable named `pdp_liv`. + +```{r building-global-expl-21, exercise = TRUE} + +``` + + + +```{r building-global-expl-21-hint-1, eval = FALSE} +... <- + model_profile( + explainer_rf, + N = 1000, + variables = "Gr_Liv_Area", + groups = "Bldg_Type" +) +``` + +```{r include = FALSE} +pdp_liv <- + model_profile( + explainer_rf, + N = 1000, + variables = "Gr_Liv_Area", + groups = "Bldg_Type" +) +``` + +### + +As a reminder, here is the code for `explainer_rf`, which was created earlier in this tutorial: + +```` +explainer_rf <- + explain_tidymodels( + rf_fit, + data = vip_train, + y = ames_train$Sale_Price, + label = "random forest", + verbose = FALSE + ) +```` + +### Exercise 22 + +Now, let's create a graph. In the code chunk below, type in `ggplot_pdp()`. Inside this funciton, pass in `pdp_liv` as the first argument and `Gr_Liv_Area` as the second argument. Then add `scale_x_log10()` to this code using the `+` operator. + +```{r building-global-expl-22, exercise = TRUE} + +``` + +```{r building-global-expl-22-hint-1, eval = FALSE} +ggplot_pdp(..., ...) + + scale_x_log10() +``` + +```{r include = FALSE} +ggplot_pdp(pdp_liv, Gr_Liv_Area) + + scale_x_log10() +``` + +### + +This will be the end result of the graph: + +```{r} +plot1 +``` + +### Exercise 23 + +Copy the previous code and add `scale_color_brewer()` to the graph. Inside this function, set `palette` to `"Dark2"`. + +```{r building-global-expl-23, exercise = TRUE} + +``` + + + +```{r building-global-expl-23-hint-1, eval = FALSE} +ggplot_pdp(pdp_liv, Gr_Liv_Area) + + scale_x_log10() + + scale_color_brewer(palette = "...") +``` + +```{r include = FALSE} +ggplot_pdp(pdp_liv, Gr_Liv_Area) + + scale_x_log10() + + scale_color_brewer(palette = "Dark2") +``` + +### + +Looking at the output, you can see an individual line for each label. + +### Exercise 24 + +Copy the previous code and add your `labs()`. The final graph should look like this: + +```{r} +plot1 +``` + +```{r building-global-expl-24, exercise = TRUE} + +``` + + + +```{r building-global-expl-24-hint-1, eval = FALSE} +ggplot_pdp(pdp_liv, Gr_Liv_Area) + + scale_x_log10() + + scale_color_brewer(palette = "Dark2") + + labs(x = "...", + y = "...", + color = NULL) +``` + +```{r include = FALSE} +ggplot_pdp(pdp_liv, Gr_Liv_Area) + + scale_x_log10() + + scale_color_brewer(palette = "Dark2") + + labs(x = "Gross living area", + y = "Sale Price (log)", + color = NULL) +``` + +### + +Looking at the graph, you can see that sale price increases the most between about 1,000 and 3,000 square feet of living area, and that different home types (like single family homes or different types of townhouses) mostly exhibit similar increasing trends in price with more living space. + +### Exercise 25 + +There is the option of using `plot(pdp_liv)` for default DALEX plots, but since a plot of the underlying data is being made, it can be faceted by one of the features to visualize if the predictions change differently and highlighting the imbalance in these subgroups. + +In the code chunk below, type in `as_tibble()`. Inside this function, type `pdp_liv$agr_profiles`. + +```{r building-global-expl-25, exercise = TRUE} + +``` + +```{r building-global-expl-25-hint-1, eval = FALSE} +as_tibble(...$agr_profiles) +``` + +```{r include = FALSE} +as_tibble(pdp_liv$agr_profiles) +``` + +### + +This code extracts `agr_profiles` and turns it into a tibble. + +### Exercise 26 + +Copy the previous code and pipe it to `mutate()`. Inside this function, set `Bldg_Type` to `stringr::str_remove()`. Inside this function, type in `_label_` as the first argument and `"random forest_"` as the second argument (Note: make sure to encase `_label_` in back ticks). + +```{r building-global-expl-26, exercise = TRUE} + +``` + + + +```{r building-global-expl-26-hint-1, eval = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + ...(... = stringr::...(`_label_`, "random forest_")) +``` + +```{r include = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) +``` + +### + +Looking at the tibble, there many building types, including `OneFam`, `Twnhs`, `TwnhsE`, `TwoFmCon`, and `Duplex`. + +### Exercise 27 + +Copy the previous code and pipe it to `ggplot()`. Inside this function, using `aes()`, set `x` to `_x_`, `y` to `_yhat_`, and `color` to `Bldg_Type` (Note: make sure to encase `_x_` and `_yhat_` in back ticks). + +```{r building-global-expl-27, exercise = TRUE} + +``` + + + +```{r building-global-expl-27-hint-1, eval = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(... = `_x_`, ... = `_yhat_`, ... = Bldg_Type)) +``` + +```{r include = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) +``` + +### + +Since `x` and `y` are the first two arguments of `aes()` by default, it isn't necessary to include `x = ` and `y = `. However, I, the author of this tutorial, recommend specifying the argument name so that when you come back to this code, it will be clear what value was assigned to what argument. + +### Exercise 28 + +Copy the previous code and add `geom_line()`. Inside this function, set `data` to `as_tibble(pdp_liv$cp_profiles)`. Then, using `aes()`, set `x` to `Gr_Liv_Area` and `group` to `_ids_` (Note: make sure to encase `_ids_` in back ticks). + +```{r building-global-expl-28, exercise = TRUE} + +``` + + + +```{r building-global-expl-28-hint-1, eval = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + ...(x = ..., group = `_ids_`) + ) +``` + +```{r include = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`) + ) +``` + +### + +Now, `as_tibble()` is turning the extract `cp_profiles` data into a tibble. + +### Exercise 29 + +Copy the previous code. Inside of `geom_line`, set `linewidth` to `0.5`, `alpha` to `0.1`, and `color` to `"gray50"`. + +```{r building-global-expl-29, exercise = TRUE} + +``` + + + +```{r building-global-expl-29-hint-1, eval = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = ..., + ... = 0.1, + color = "..." + ) +``` + +```{r include = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) +``` + +### + +Aggregating local explanations to create a global explanation requires considering the context and relationships between different instances. The behavior of the model for one instance might not be representative of its behavior for the entire dataset. + +### Exercise 30 + +Copy the previous code and add another `geom_line()` to the code. Inside this function, set `linewidth` to `1.2`, `alpha` to `0.8`, and `show.legend` to `FALSE`. + +```{r building-global-expl-30, exercise = TRUE} + +``` + + + +```{r building-global-expl-30-hint-1, eval = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) + + geom_line( + linewidth = ..., + ... = 0.8, + show.legend = ... + ) +``` + +```{r include = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) + + geom_line( + linewidth = 1.2, + alpha = 0.8, + show.legend = FALSE + ) +``` + +### + +As you can see, this graph is starting to come together. Each individual label is present on this graph, represented by a different color. + +### Exercise 31 + +Copy the previous code and add `scale_x_log10()`. Then, add `facet_wrap()`. Inside this function, type in `~Bldg_Type`. + +```{r building-global-expl-31, exercise = TRUE} + +``` + + + +```{r building-global-expl-31-hint-1, eval = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) + + geom_line( + linewidth = 1.2, + alpha = 0.8, + show.legend = FALSE + ) + + ...() + + facet_wrap(~Bldg_Type) +``` + +```{r include = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) + + geom_line( + linewidth = 1.2, + alpha = 0.8, + show.legend = FALSE + ) + + scale_x_log10() + + facet_wrap(~Bldg_Type) +``` + +### + +With `facet_wrap()`, you use the tilda `~` to specify the variable you will be faceting by. In this case, by specifying `Bldg_Type`, the single graph is split into 5 individual graph; one for each building type. + +### Exercise 32 + +Copy the previous code and add `scale_color_brewer()`. Inside this function, set `palette` to `"Dark2"`. + +```{r building-global-expl-32, exercise = TRUE} + +``` + + + +```{r building-global-expl-32-hint-1, eval = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) + + geom_line( + linewidth = 1.2, + alpha = 0.8, + show.legend = FALSE + ) + + scale_x_log10() + + facet_wrap(~Bldg_Type) + + scale_color_brewer(palette = "...") +``` + +```{r include = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) + + geom_line( + linewidth = 1.2, + alpha = 0.8, + show.legend = FALSE + ) + + scale_x_log10() + + facet_wrap(~Bldg_Type) + + scale_color_brewer(palette = "Dark2") +``` + +### + +Some other `palette` values include `"RdBu"`, `"Accent"`, and `"PiYG"`. + +### Exercise 33 + +Copy the previous code and add your `labs()`. The final graph should look like this: + +```{r} +plot2 +``` + +```{r building-global-expl-33, exercise = TRUE} + +``` + + + +```{r building-global-expl-33-hint-1, eval = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) + + geom_line( + linewidth = 1.2, + alpha = 0.8, + show.legend = FALSE + ) + + scale_x_log10() + + facet_wrap(~Bldg_Type) + + scale_color_brewer(palette = "Dark2") + + labs(... = "Gross living area", + ... = "Sale Price (log)", + color = NULL) + +``` + +```{r include = FALSE} +as_tibble(pdp_liv$agr_profiles) |> + mutate(Bldg_Type = stringr::str_remove(`_label_`, "random forest_")) |> + ggplot(aes(x = `_x_`, y = `_yhat_`, color = Bldg_Type)) + + geom_line( + data = as_tibble(pdp_liv$cp_profiles), + aes(x = Gr_Liv_Area, group = `_ids_`), + linewidth = 0.5, + alpha = 0.1, + color = "gray50" + ) + + geom_line( + linewidth = 1.2, + alpha = 0.8, + show.legend = FALSE + ) + + scale_x_log10() + + facet_wrap(~Bldg_Type) + + scale_color_brewer(palette = "Dark2") + + labs(x = "Gross living area", + y = "Sale Price (log)", + color = NULL) +``` + +### + +There is no one correct approach for building model explanations, and the options outlined in this chapter are not exhaustive. This section of the tutorial has highlighted good options for explanations at both the individual and global level, as well as how to bridge from one to the other, and [*Chapter 18*](https://www.tmwr.org/explain) points you to Biecek and Burzykowski [2021](https://www.tmwr.org/explain#ref-Biecek2021) and Molnar [2020](https://www.tmwr.org/explain#ref-Molnar2021) for further reading. + +## Back to Beans! +### + +In Chapter [16](https://www.tmwr.org/dimensionality#dimensionality), how to use dimensionality reduction as a feature engineering or preprocessing step when modeling high-dimensional data was discussed. For the example data set of dry bean morphology measures predicting bean type, great results were seen from partial least squares (PLS) dimensionality reduction combined with a regularized discriminant analysis model. Which of those morphological characteristics were most important in the bean type predictions? + +### Exercise 1 + +Take a look at the code from Chapter 16, which eventually led to the creation of `rda_wflow_edit`: + +```` +set.seed(1601) + +bean_split <- initial_split(beans, strata = class, prop = 3/4) +bean_train <- training(bean_split) +bean_test <- testing(bean_split) + +set.seed(1602) + +bean_val <- validation_split(bean_train, strata = class, prop = 4/5) + +bean_rec <- + recipe(class ~ ., data = analysis(bean_val$splits[[1]])) |> + step_zv(all_numeric_predictors()) |> + step_orderNorm(all_numeric_predictors()) |> + step_normalize(all_numeric_predictors()) + +bean_rec_trained <- prep(bean_rec) + +bean_validation <- + bean_val$splits |> + pluck(1) |> + assessment() + +bean_val_processed <- bake(bean_rec_trained, new_data = bean_validation) + +plot_validation_results <- function(recipe, dat = assessment(bean_val$splits[[1]])) { + recipe |> + prep() |> + bake(new_data = dat) |> + ggplot(aes(x = .panel_x, y = .panel_y, color = class, fill = class)) + + geom_point(alpha = 0.4, size = 0.5) + + geom_autodensity(alpha = 0.3) + + facet_matrix(vars(-class), layer.diag = 2) + + scale_color_brewer(palette = "Dark2") + + scale_fill_brewer(palette = "Dark2") +} + +UMAP_plot <- bean_rec_trained |> + step_umap(all_numeric_predictors(), num_comp = 4) |> + plot_validation_results() + + ggtitle("UMAP") + +mlp_spec <- + mlp(hidden_units = tune(), penalty = tune(), epochs = tune()) |> + set_engine('nnet') |> + set_mode('classification') + +bagging_spec <- + bag_tree() |> + set_engine('rpart') |> + set_mode('classification') + +fda_spec <- + discrim_flexible(prod_degree = tune()) |> + set_engine('earth') + +rda_spec <- + discrim_regularized(frac_common_cov = tune(), frac_identity = tune()) |> + set_engine('klaR') + +bayes_spec <- + naive_Bayes() |> + set_engine('klaR') + +bean_rec1 <- + recipe(class ~ ., data = bean_train) |> + step_zv(all_numeric_predictors()) |> + step_orderNorm(all_numeric_predictors()) |> + step_normalize(all_numeric_predictors()) + +pls_rec <- + bean_rec1 |> + step_pls(all_numeric_predictors(), outcome = "class", num_comp = tune()) + +umap_rec <- + bean_rec1 |> + step_umap( + all_numeric_predictors(), + outcome = "class", + num_comp = tune(), + neighbors = tune(), + min_dist = tune() + ) + +ctrl <- + control_grid(parallel_over = "everything") + +bean_res <- + workflow_set( + preproc = list(basic = class ~., pls = pls_rec, umap = umap_rec), + models = list(bayes = bayes_spec, fda = fda_spec, + rda = rda_spec, bag = bagging_spec, + mlp = mlp_spec) + ) |> + workflow_map( + verbose = TRUE, + seed = 1603, + resamples = bean_val, + grid = 10, + metrics = metric_set(roc_auc), + control = ctrl + ) + +rankings <- + rank_results(bean_res, select_best = TRUE) |> + mutate(method = map_chr(wflow_id, ~ str_split(.x, "_", simplify = TRUE)[1])) + +rda_res <- + bean_res |> + extract_workflow("pls_rda") |> + finalize_workflow( + bean_res |> + extract_workflow_set_result("pls_rda") |> + select_best(metric = "roc_auc") + ) |> + last_fit(split = bean_split, metrics = metric_set(roc_auc)) + +rda_wflow_fit <- extract_workflow(rda_res) +```` + +### + +Using `rda_wflow_fit` the following question can be answered: Which of those morphological characteristics were most important in the bean type predictions? + +### Exercise 2 + +The same approach outlined throughout this chapter can be used here to create a model-agnostic explainer and compute, say, global model explanations via `model_parts()`: + +``` +set.seed(1807) +vip_beans <- + explain_tidymodels( + rda_wflow_fit, + data = bean_train |> select(-class), + y = bean_train$class, + label = "RDA", + verbose = FALSE + ) |> + model_parts() +``` + +### + +By using `ggplot_imp(vip_beans)`, the following graph would be produced: + +```{r} +knitr::include_graphics("images/pic4.png") +``` + +### Exercise 3 + +The graph above shows that shape factors are among the most important features for predicting bean type, especially shape factor 4, a measure of solidity that takes into account the area $A$, major axis $L$, and minor axis $l$: + +$$\text{SF4} = \frac{A}{\pi(L/2)(l/2)}$$ + +### + +Looking at the graph, you can see that shape factor 1 (the ratio of the major axis to the area), the minor axis length, and roundness are the next most important bean characteristics for predicting bean variety. + + +## Summary +### + +In this tutorial, you have learned: + +- How to create a model explainer with the use of `explain_tidymodels()` +- How to create local model explanations with the use of `predict_parts()` +- How to create global model explanations with the use of `model_parts()` and the `ggplot_imp()` function you created +- How to build global explanations from local ones with the use of `model_profile()` and the `ggplot_pdp()` function you created +- How to explore, analyze, and plot the underlying data + ```{r download-answers, child = system.file("child_documents/download_answers.Rmd", package = "tutorial.helpers")} ``` From c7ae17432918fff40160c3e21a177ca29d422966 Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Fri, 11 Aug 2023 17:34:07 -0500 Subject: [PATCH 08/12] - edited description file - Finished Chapter 20 tutorial --- DESCRIPTION | 1 + .../20-ensembles-of-models/images/pic1.png | Bin 0 -> 26057 bytes .../20-ensembles-of-models/images/pic2.png | Bin 0 -> 32690 bytes .../20-ensembles-of-models/tutorial.Rmd | 990 ++++++++++++++++++ 4 files changed, 991 insertions(+) create mode 100644 inst/tutorials/20-ensembles-of-models/images/pic1.png create mode 100644 inst/tutorials/20-ensembles-of-models/images/pic2.png create mode 100644 inst/tutorials/20-ensembles-of-models/tutorial.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index 672156f..3efb65b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -45,6 +45,7 @@ Suggests: rsconnect, rstanarm, rules, + stacks, stringr, testthat (>= 3.0.0), tidymodels, diff --git a/inst/tutorials/20-ensembles-of-models/images/pic1.png b/inst/tutorials/20-ensembles-of-models/images/pic1.png new file mode 100644 index 0000000000000000000000000000000000000000..60ec76bd98ea5b8cfa55e4e37719b8f40fa5f1a1 GIT binary patch literal 26057 zcmce-X*iqT*FV}>OVzj4(o%G!D5|EKJEP5kpb) z5X6*3%@Gk}f=F_Ff6xDUbI$+G8J_dvzV^NLmF&ItwfDW(`mD7+QLlA1IobKxj~zS4 zsrB-?{;^{xC666D9&q-|QBNhk-07$}?yIl)^jO8fb>fk5%JB){$+2U<;y4a%P9MqV zyk4669y@lS{om(!muJ!YW5?{Rw4OgP46q{OxcrP3p%hje8h^#OaiNw3Q-{s^LA;b# zptpeR16Swnc}WnBm=|A3^GLpUeW#{J`<1bci;Y+FZA>AS^_fP_JojB6+!&Q3N4D0CS*gxi{juv?Am~C9kzv@3;yIB9P_*L};@4xLY&Dno{e}j6~ z;$QK%U^vH7^I_t)*YTtFAMpR(KL@?em;cUJ_{LO-zt3!PZ~E;|cn9hNCJ%ST!F+78 zE(ycWpFk_Ot()`_qnVOP5<}}U>w1a}^YOG$2c_7CSWAnCFXhRkpbm687F<71Qj!_7T|J zOR6aUgO`MQI;fW#OqcDA);tE?^m@X@m-|ICZq;dSvrRu4Qi!QLl_Fs2H2&@Q^gp;} z)t{d98pBe&M$MX8_Tb3|9STw0bV@sjj`6W5Osu~<>Ey>&!*WAG1M_E=W4?C|l z(MJ6y4i%7ZQ};N0WCW(Wvi%09fws!3tp(j{BHA@Or&(!|O>Gj9%c!NGZO`Iwk$Z?n zfK%4W=k+PwGpbYu{WQj=f~@b(%P#>ob{YFiEZJSf#Xwa4+@}K*X?1hz;ycW^FA7;B zCDskgWLtgg3EbC~(=TN!g&(Y}H1W7>tr185ehTV8eMSN-s1P3M+)^Tvfj(dtaW^EF z@0tO_CMK_CEBLs6%p0+%_ai-QQqviw6>?xZH9CFS^?v{9yl@IZ5my7P*i;hA?;^Tj zENIKm_!y$ThC8T zC0DitF}-#1%N7PY30ug(J0V?3AusVMEZkaUflqSK{g~0Mg}9q+0ojQ@FQfu2`s~_C z9)Yh@7`-VXWeXJOzMJh5d9O=RQLld20Ny%jm#`C}uO_ui2P1qJ)o(9etxGb(KQ}=!jmEvN1`b>a4(+eB^fb3O1HPRKZKQ*Lo-Y*4o+X^vue&X^@P{qj{jN~m zXowC2tZAh+rAue-g=M=BuBs|dGjJh#G=YTLR5_fon)p4tW*u#=+jfFpgl#IBxSRer zd~ER-mnXX_gI)>=LqP<4MZUDERoYH(WjfkZ+e;U;n0 zU8xa^2cHbn?gdAMu*1xQm|FDjzeCT&8LfsQfg@Ybyr7wM$AXIaf0C~vSLbQoBv6lP03ZFE zH+~2H2_X`qdV$iq+QGe#; zj6>M#&+a19S3DXo2*+&Q4MVqS)dlX~^)@c+9@u0Cd(SH0*HKSQF<7#@>MjH?mETPN zR5AVteEt)q_eYni;~_~tVH?^nv|htdYYm>OMKi{dEZo%)^XIe0rO+-932kTT-=8D` z&10Rv#}KRw4~DgC?t3kH{l+p#<5L{%ta6#QOJIF`u{Z_Ret5LRCw0)&n%A6^q zE0=D9k*iRR+v{p(7Ge+Wgv9LC#STSt$oseFqyZJTB{I|#2X`W}1qNi$K|qaJ)f5vG zH|)H#qeDVq;JxDW4fD)}`EEy}ge}jn7K?YP)y#_+H=X1CW-JtoJVOU1z7`n}v$T9d zH~eZX3Zu*|ITnuWob*2`0s`a{)HZc-d6vWK`#s(}%V_cPG>B+!(3sFFMrxc(Hv20y)6cG7p*gw?haD;hLR>jwH8tV)OVSZDbp zCF<;^V?Ewyj!&P)C9F62{h9#>J+tI^uX%L+_GCw@n*)SjZctL}HA9h_Te#j!akFPF zzdjyHP?_T$Pxrb7ly7V;Z*Bahu_q~7DZs_L@QU}(HSP~cxaCre&J@LdE8f)*v%Cy? z3R<@_34p%FIPVAFlA37jZ9r=z)!)_+J-nc&YdNLP|5aqmes(zHg*O{uyi)?BTtWWX z)rSA_Q=E{C=^6$4d3x&44FqcTHv^-G1wh8<)he^@db{Bu2hHov=h^}hgF&}&pOCr# zrTxO=Bkhac=#|S_GOKUgR6uVVmCX%xN)m=|i`Wg>URhlwwZY+X%}CWH5WFWuMN;%3 zf$Wt?%v!pw{U9~&J4O)c^P(#|)R8hb-azCN4SFy1><;dqTgk+)NM}JyVxObBdAe3o z^?Dn#Fy<`?fI&zZvX#8y{}}!;WFbTo{w`~^O&Xw+8k7tE^l>1&W@B*4Pdl*BO!pxm zs&~x8Povt8V$r;opV!R+})%c_&0cfTmxp&WOlQ>WH4P*pmixAi>U%kBCvP_7|$cL<4WF zf%&_M*M#Lf8=S_eh-GPrVS+cKns7te_6jRfl&=; zOWuu!;Fxk-gZjsRUNv6$t)letALYtw0?XzVt*$cpmEiCWEaonoUDUhI3W}T|nV>Md zf^>cqn7#Su*}%L_a|R=P=&W=6Zx03Fx8KXIz}|mAeU}8zPUl!#r_9)#W1o(tJNGn`XK zMq^M1)jIZ3$J%s@AJSi6FLOjF(B&H6QVLJ0HoO-XVX6sZ$Nb;*=%$iu4{qFZM1mx& zUv!@&f70_8Fc8e@xh$I*iIkTX*lmOEKezUeN7bZ(FC06j)DdejeIa-?=M`+xe<3)$ z$CyXtwAhOKmLBLBwCmcD=a1||Uy$5QAu+47^kW*o4Y(4XBTp`KJ078c6=9}n(yV29 z0zCAzcV{8xj|lF#-+$u*yOOK_JA8oXLU=0%ZWVz4g;6=^t4e-F;BnRZM?y#9<27lc z^Z#l8XQ9V`>-9kpTf~|F!r3sQ>j*Qr{7Rl+aW0uUNPu|)2#&2;Jaq+$Y6p)22oG$6 zvgi23Z*SzfL%(^grRG3AFzEFG&1pEAz~@T+D~Jl{kzgMtQV2fJ)%WmE>?i$B*#x>( z_rUP^oOHr4n^418(BmnZ$C0Z&I?SiK`$mpAY<*dSgl;Y(56Z2cq)oYmlp13yu9Z6z zTn$Uj&*ZRfc^&_-y`&Fd4cG;(#V>R%+@d+Y409XJuS+5>H7cykvKkB%(Ll7IIogl| z!Jn5HDer_=a2X50gMWq%(a{fa#4yj1?v!=b1}s(HiJbBRMX>?_GzA-3=GJ4$L4awr zDxgY8F;0NxOCg~M)g`+Ml$BA_y8Ccrfk6K#`KGC)>g;8Fm>wX^%?J}^pmm({12gIf z8V+RWmF`I)Mw7#!hxeFCbYCN zE{KZP-8-UQ=|IfNjbUZ`7BUmtO_+bgJ+c~!OB5|ww=<{Q>zey zMphYRh0j;-*!wnF;foOGeR_RdMwBCQm=EE0sjC~M4(23u-qX7Ck69W=(Dc_V>>!w~ zf!ZFdG4opnn7RTVJc=w@{OZC|lm6mT<}gh(2v67YNA^ejCLly*!dT&aC!dYQ zjQQ`2k=2mqu8uLgFm3>S;0g4gNJF#s{_9COk46Hn9QMOmjgtMcX>e^CpuO`ctY12o z)g_F28xrTyJm3MU?(tBd1d6v$>`VERhE4jZ5y8)Bguucxp?wm1_nHh-&wvq*u}<{L zNssLQS_(erpyk(AGpXoq(B@}F2T-bWwW=_-e|#!6LBzi1dij{DLIdS}EKLUeQk6EG zha+4sAI|4>0_ALH(?ed=hPWvf87TlpRO#esGQ^$cX*eshrRbj?JonHt=u3z`LYU%f zsn!Ut!%NdC%T<#Ht>{VgwTo&pG@5+&CUz-+0o)pGOUa+ES@2K2AnyrLp~m8N%%|nZ z2c|)z>x92XV%xEwz!ZM|KBR+C=}Gg-z}@b<5OU8~=!<~Cl-n-nbRxIm2!K9W9i5LO zKyg-rJSzLTv)^?~A=EN=!oUiN*QuSkAft9{?#qA9i!qc=MH;_&T=JUcvQG@h7D%&x%rDo-wA`K?y>! zEXhc9AMNa6!H!1)y4;M*@#jJZgg~xibykM0F*L|vy$+ypefT2+mwTFxZ8gP{fcRpk zUf#KE?A#hVDsy}qI5-z%89dKGqHQzPaEE#4Y>iiE(T(cxgB5`>d{9-23N1?#yXG_!o?l1(pm4_V z@hy}TR_#KQP9lpbAG2*N2>*f~ZJqWjR6Uux{Hu2*pEfq)mTggTvsDJHDKu2(Dez`f zfb~wzx0pHY*k5@zdvbDqw^dtPb~BbUXp?|0A_{xrtv9XZW(&y&@tncx<|SV^nq8t0N#HDGZLIiYdTH# z33C{wKo6jJ4{&fEy^ngBH3u53Gn$}PQ{dZGkxlM#Gb^zJ%5imoY6OK5Kbi5_*BwzV zDop||Z2wlnZMw~B3u@uV!Gi-^R*2xc45t%cMF#4RwFD*xc{lT0>gnekCp+?=nMf62 zZ!SX2nB8aCe)5oPG^GX8*h)Ngb>^M*^A#40tXw_$N`GPZ<0{dtaMSS;T4?ISjurKK z)~=9T%XFlkYl}$J>5&$_3=^9(F7Ipw>|PF^rLbVMi?op9VUXc-cP2>)UF8z zf_FTLyyje2AN{7Y{uFPJ3(x7cBOS_kRP1=OMuhZX^;go`(;m#)wVs4Laxfu{41zgs z^~{G{q)8h!cU81sEQhX+qnQp8flI1atg2q?g@Jr};WNxqCK|pPSup(%QnA={e?#cG}`qJl*=+b8x%)X1+-2=)y7% z6t@Zct%`(8J0q`s*t_|!0TtezJG{u3aO8KM=6kbQW)-?FErBBHqgW$m67|J899A1r zKB5~Rzx__iU+7YJ)yNuI8aGDM4~fUa2W(!4vlcsX&}Q|xezX$VmNbX1pNhtqSwDh2 z#EJh-=j{h&!#N|_R?x;X6nEdhz;(|+@z+l(ik)+Pnh@gjwB=u%>f5w;%1pI)9i`OO%G3-}H8 z-!1%Wa@&HM%EECx$1~@{bf&Y#BMT|7TZ=MkHhi`hM)QMq(tku33^wJ1W@65oS+U|* zS@!^}bvtAiKCsV?HqxZIE%j#8iO#x+nzv+|Q>MMC$a1Zw0quphRs98&KF(j%_@d?b z$ETZ-4pp)GB#GfAPeQGmif)I~in$#X*rn)sYp~cu-wm3Tj@99p{^--l1F5!c+ZU&w z`8iLT00$2kL3wRWbq&UBVSkxtZulQXm1mm*tpV!Fwn~=WaWEa;I{1MdYJ5s)o=(l5 zVys3_F>zhMq5Fc~{mEjo&{}agu5?5%b0i<6gGr!}jTuZKr}jFy^Uef#$F^>U9n`p9 zJTV(WoHWCLB!mJu~{p^x=qkcFrAY3=Z)0nQtddIi~;8!-I)mJ^&QZp_? zggTbf8s&FMp2m~+l|$fGntil@oyKih>VY%FxWST=7ALSLk{SSA6AB(&8)V{wMuP{z zSzLs;K6W{e5tBZD{BXW@suP_VM6Sq!I}Zj!2F9>3DvtDJxp^V7Z{VR8lJm?tdn%y(meWB2zuJwAea+U>&yd9CMTf9e&LDt=GH~n<;$fHYV1oip(NzrqxYQ%Y+ z@O9YL$$Wk1ju)!ts+OscX6M$T=^d`R*r5*!wXVs;4YWbi>p|6q*GwaYVa_Ix^sJ(L zV=aUxrxTIMQ;aS|5jDL~3>Y?er-zdPs-`eTxlw5ZkrW9+p;iGf>AyTu@n$Lo*wrZY(wYF}ZP!vi) zX3OGCgYSR(J}_-tJ{&*leD}YHWd9TS9&F>u)HpLgw=VX6ly})HZEd3=Q z;Za_%T*2o_aP6xyj6&Ok4P7YL>Xb&Rm*b14{pN1hJ$Ozck>tjevuud(not0Rz%ZfG zUCp-DC?2w9(#yo(c4fl-7G=AQvBh^6tIYKTU-!>Bi*b~hR8az^f}95gv9*DrC?m{D z%I>SECRJnc3t7P4r@^CTP~XFO(*~&~o$P=)VG5-XTaNwpvp{PU-WqAL>^UB84GZ>n zoQja?s&?PJ4?qrhOcyLR?M`JNarhOtD!#s7MQLW^p))-&W2cVTox{wrbW}+-#kv}s zl%Qkg_pW$9lf+AEajv_^n_=82Pf8}#V-+(Q`||y}Bln(N>)Hn{)l=0f-&S3+mw3a) z-1|JR6py|H42B)FVq8}H)9vK^mmCCGLlV7(i)sEIfgL+}K40~j=KR(8T4 zO{ohOX27zb5-~x=f^n&oQWvrhPSxWl#Jc!Re{V>kHYHOv*G}Di?2nCx*nidEeKTNGr&HEdQ(){vuIXVZ*iL=ws<`ks+48lUM>Q1*)&;p@wM|D#6Brk+E_6b z7~Du6Xs!gvse`22ss%B4xFvS39XdrfOF0=}+K@8+u&VaecGs0vC~uu}hmNnxG$~5A zn$z(@(TLxY0;}NhUC>l@X5OvDX4gLdI>tyjhNDK_W4w%|21s6d8~ng6Z@n2Y62PUvgWWHs6q66|!Bu-a6 zXq3pyTe{ZSU}pDmHoVYR$JBSXu$+yOQ98y}b?PQ`cq-2T?QBHy)Lj{6^Dw>8FNJkt zaC_RHtBomIWbKHe?3votoKaoe3S2Z+>~SZ?w46gcp z-)+1$tlCJ!)Bo4ECd#59t6|7`h8aS(t3SiL7aecf+Ql)tF(fbd+0VkvO7=;A<7o$h zx*KB@F6U)mn9S}MpX4|hL|Bt`WEh1d+V_Js2k+nGUv}M}&yelnK_8rS@p9~pW!1mv z>I+RGSeG|?UPmPGFFEZmF@pB@#VqMsVNgRjSH*Cd`8er{WvMH|hl741QSvmLw6l@* zqa|mzzE&-$#atw@3b8h->w7;^PeMWSh0?~>-@Ye{@Nb6?4V0cNCXY=8W`{%;i(G(i zu<%i}fA^|fb+W{UlITLl$*C#ZH6D|fw^JS5Lkd%4VUU4|xyCx;???@?u)WBjx#oSy z)?)lpV=`&I2D~#fE@Bu$^1@X5iENwdp~_ONL(P1f|8ehiWbM{l^w?8}ol%uRDX?;| z1|O*0t@i^*>F#odQN!vLC?g=MBx@3}+T&v|ZV}S39~rd1DS)K(R+N(@d96!J7{Xy> zYxw4;naZ+(RouLyugSs|WqHhoFVH9tM-^(nMdm>$l$E!&UgCKifW2fb5f!j}*#BS#)>VdR-qho?Xe}S6~w0O;YtjY5zT}CzjakPm$QP+ zTp55M6C_$h{SrLKJk$(+#a9Ui@KaHO2?mh*wzoe)9V++Y&pY36ab5zlzr(YEec!vZeTQSp0p;1I`Jnhwj9hh%=VLn>~L{5N7q=!Hn#pr*+JY^R% zq7AqH>Z-oYc&L9!H!<9P{fS*CUvW9w!}J@54Fvh{1W8>=hXlru*P8R7Y`(fTHcqcz zMu$3&HEp6`H0Uck0*U~rzb!9*hHGn{joz+tT74%FRwV4+GauzR zUbMdB)sJrXKh>5w&U8d24JQ$0@2>tmWsmL83Ee7!qcr zIdvttEewA^5qgin*scCQ33{h0Oi1#Zfoo**tyyXQL88-(jJB@-KM)pz*w@tZ#=At3PX4Up3n||uPMQT z;AI1l*^Gy<7m}S%iYQ;bhX^0YK#27qo)M?YbN|qGwU>UmXV-(_^ zrdC8K`^L$p|Kd28bAP6s616xAIp{{8(i6ZAj8z$K2f-ZH%dAX+iAM&j?0DgJO>nzU z|8;*eWlB1qn)+e>pz|TbrN54|!FhDqvuIqYDh!rZeAw(_q%N-!vU1kkziyG6(Wey2 z_FbA}=(@jSql7BeHz2PhSYi!-v!x7??44WLNTlxyF z*=&rz#L$8NbDXZzv^%ES7VFGOH{V8$OOEUvkE{vRot3TKx2p1xZtW|!fmBXh&+v@J zemKJ&kddP>Eq4<&;3(oWAfTaynzvzWSl0E)ig(qimz@-XH2ILO?*H{*_dU<0;+}zY zm0Lncj(1>nhm+zm95#q2uf^$+*g~yTz%WxzbHPz#?(ECKfq5^$pT3?(?nKX{A{uOP z06y@%MIxoIR`)1<#`8TbcXe!$55KIN3Q_Vuu;gQHo>AQ^2$RTK?z3`dT2-CVLuqr% zK+lHJKdi3FR(jjX9whR*_7#XO)eD;7;$*%j)n*w)mx|~rtdF+WW<9W+OvfUFZs||| zD4U&odZh+beLoS-B>te4EuhbH+^0zB7TIKT7IDZj5y-$ZZ6p%Vge;mIY*#~&mxn0r zRp{(~FHRJy1ls$8p(;!2X~->Ww?Utr2td8L42s&Hq@%!aSW0bs(o!%yX6~CTY!S5v|ehIr*^0AQ>BDG`VXp{NZ8v2=Zk2C&-F7 zO2KP?;z56aR}CzqBv3JxA9q_Z7A1h9*xrK z^~}ymkV2Ba^8^RE;T7WH&p0gufXJbxLExC7^G8*x zaX57Ar!{ySU%tiv%J88F%mM!{1xh6>m z)N}2^{n7#p^Cf|8rxS!3LU`{fzgS0yOtql{3@UWi8*@447p9(lE$IyAI&>g7*dIT? z+)>F7FW#cV<+i9Us&zY4R8a_T#ty;HF^U~$;M^-E4rz)_Lg)j*x_;`t_p62Es9$vF@#@o!}>nL^v(Nx`2h*g)FW{ zWh|9rbEDx!E+papJzpB_rTa5~2?W+DrrY3P=6e7BE6*}V^WAW4&iBzDEUfuZh-3yr zLf=e1wEMiWcZS?UT_ zGR;dcl3H!|PO*-l*wwPXCRPIWb2H2u+;I_mE8aML)^_rwsZ=G8zSn~ z4osQFBiY&Vo5A0Vl}iHJ8etlr*j!pD<~!@>w)-P^TxKIfHe~HbI#zq-mV4?9eW&jL zrZ1)OT+S5pw@eqyuHw+k*r{gmLL!C^X-hY`|4i6{%s3Gf+c!QL?UX!mWIUWW;NQlfKJ=SEBfE?X9~u4weEcBGgAZ3k`LL+|>nvu)YTm+l3`V;kp?JjRte{=Q%=bzhLhGXgKj&8@2N1|^ zz}17qzhe8_NeNdA-T&k)?(UYntv2Y-&d3?#8W{R%rP$^2vn0N4JG`AAZef@wsvcu!<@lQ66cv$Suqjpr>OE&q%D=m}|LK zr^iFo&p@fETx2SqPIWyrG~jBo%y;I7J8vSPE&+9}K+mNu&#eO^ZbJ{YR@4orrXG{@ z&~KCI@nx%XLhql%t>D6=4PL)3h_@<0nQ^au#CR4@I&6*4PpLQ>cU|VkOw(I47m*(m2EmsCN0C~m*+NZ=i_vS-Q~V0Oqy7+i8tX+iW@mun{@ zS`L5TBXsTuzVZpAaa$A6ek`T|qaMMOMSgCDRN6LlhLt>V_4w7bF3dfVIkKT_Tsjle z$z!2to#7!=u_SQCYU2^HcGuc)duXIwUf~63?&_@DUhiSe>p4X)ZDx5|v#e{;*fJaG+C83Og&F@>^d4H1>=rx#( z@u57VMxxS*MhzhI-IEBCXw${nk!xlltjkx@B7C<&4`<|h7t&i(CplV5Yl_>XIwEx= zEDG>K!A;L))&O!=gp!^`^D(y*J&K7Bu?;IIfbD3;$)Z^Ty9(cO#TqvLPe*Yd?T07Zw0QZ_!3j%%kp3e6&=r=EPdQg2{xmH z3`A7qXrvZ|lYO8J?UnUU<^3}7fx=TRqW33jQ1qU_dUl}Jn@3H*8-*8tvl1lTDLENk zseSVtt^3K%e-+eoSJ@SwVf@X6GAU4bfnYnMZ1N9bt;|?vK=_%oYIjASmc|KLZ(b4b zT127Fr$?JU&;Z+pdV6wS3~66eVv^A{zFf^Jetg;} zpy8FGI zIr{*kxIO-w)Y3x0DYYNi%8OpD*fNEEI`pU_Ue_Bw%ya!W@^ zoU4+ALG}7y{PpU$r}_5lwo%ljos|BPZOI6|@hxf;H9AX*$&Eg&X8t+~?Z-X*%;Vs# ziNcnFLT#VG0(9 z4e<~!x(@{=GVdO;F(0vW?Y`o3QC4~JIV!!*Z(`u<{?jN)iUis1ZL_xJhD{GCjaU=j zOAHa0b;Zj9nu_&FAc3J@LX^=1@H$4&Zy`Ff9cJg#LKlcgAM*_S zQrifa$sHIq84CKnMucQeE|5@ z`%^AM53X3crN){}a>BUHCRUB8`3Qd~wR!v|gKVzkzmP_I^t1FuG;hV5Pk=#B-JKC> z>3-K`R?#qCh%&ZBcW~a!`guF#vFm!t=r;{tIrovblz}_q{&xxF^8MnDlDBSxGM@UA za#RoBDCPMy_Q22v;(1iwmBlMoc$Wzi_%27UVNkC_*lz~Myc|YXUK5}N78%z^)4OUG4Vqd% ze8(CDNRHPKini49_rc7IO+5=%-;M^RI& z9w$;1kbp931*Vf&JybiaLGcT=@o z2nA9*U2P47xt9cYPU}GI#-dUDP}#NVvJN8>aHc8ju)1=n^F(A-|C zSSWP&rKj-6@i5{$`qmL;eKUV8RP!gq{(=|zSr97@BXiIaO_dQ!Sijo$a+Su zbhdIigJfJZ*UTrNq+qr!6sk+Q#A}fLIJd;7iG8riR>_+Svc4AJ9^?QOhFo|FO84@O zg4Csbr2aV$vX`LK*r8z+WZUk(F3|zjRRfU@+hJp!3vr<4CXF6 zJSvQse&dVbQUWg}nHlE&UDq`Y8EEA*x?i>-C_c`3O}W5_*yq;?3gY#F4!Ewi$uFfz{Z=r zMj`OijG2}7Ez@>Dp&`7Z@vxW0{^ICEbWPUka$pQCl=qC81J}5@Yl1rrIqM>u8FSVK z-Rp1j=~)5V8dnC3gIu@@d%MoKw((UlrnN^865Y*w2ieD(f?sJ=VV&R1sqKFfal*yA z^zWA%3xwLnhyem0Z8YBMH?6ui$5;p7^tE^e8+a3#A`@4xsq=%DtA&x$+ocSptR~vY zF1o_J?2%cwS{FJr2(p|INKN3rJalj3Wxqn#v=w&51&*Gv>)B$dMpyfV-_mLm%4S_@ z&chEdn^w&)rbD;FML&_MZ+l_B-4PNWNkeBKhLq*J7#sd%l$5F6=UH0{|!Str!&Fu3#=sKvaY|-P> zVP*y4_~MomM*%zi)~;yT1}N3CX(I}1)mXpZe2Qwv3ikt0A)w`9X z5KJoKg;%OcWk1zdgF3F4gO|?r*D0J_;Z!p&YNhtAh;S@gXIbWiXA90PHs zrpWs5bnH>;^}q75E1Ulr^BD45vF*`Z|G$vz@c-^zY?G`@d(q@nsB3ww@prG@f2<{@ zEZ@M4B5~Sw2Pyex0bjs>WsT!T)5wz(nbZ^0!~a?YGgU zO9%Ta$m`DWtr`6N2d#(kcYgIpPATbc^w&oAIU25AXu2%{c(!F3Hl7}YNrrx3ypwH* zPamWx1m(?q)&|FEr@k`{3IlyH<+<;<;v1Bswy|Zb&*UuSdYV!=cKfRg?Av1Zi*0|u z!Pwey{3_2aJU-x6>4j7mVnRz%@0B_yqLVYdG{z%*Hw)4i)bVVl_vPBxc!7rWiYeZd zl2HkOPl?v9|0(H5PcI+o2|4S0ajDNkm02Jg;vezmKn6j~=~tIJrTIbA>2C_L#Cktz z->_7p(X|eIJ6s^&{|iI~jP%>fu~MGr*)@QcEAXSyuXgiOS5t=KhgP~WgOoD_#T0Cw z;xT(A*%7T(sb3OP(hs~F1qqnBlpHBy@j(vJgsQVw*)oa#ad5*Y?3lO4Y(gpz3Txq} z^gt5>|9Yd=EMg`vU(*2o@N&uC_7d7!F5M6~AX}`}A*P$Y^<#{GNwwFdpIW8kT5p?q z&Rn0*1|j3dx8eG*nPdN30?*A#g@_2=00&z&jNDffDMg4{h|SAi#Ixh2#3V3I3RsE% zJ|rFM-&b5$wOZ`MeT$(Q>L`1$ovlbd6irKhwJjmZ2F+Opp8(th%q`8R^EczK| zB~*e8>*P{vJVB$o0A&AtJ6(5$Z%I6&dEfcK;f^Td5cOik(K8g}x92(LPFv{=^>pkT z8HyklfobsFby$z}9{u;Q8tElx80Jzol{132yve#s&uaCl2cJgrv}Z2;N8dCFy{V#n zsmr9z$NbEI;ZOlii}_0p>K`U#*sou}6Y^P#oE99B+m&!h-zd8PTQMa_eHq_y@Pf+3=UENn9>798vyF z#vQdsaVzMe&Z~g1W1AYYA47$`72=5{fCkLVsh52@-Bb1UK~qlen)ylrB3Q$3^pgf= zhn;3qRvG0_HR5{UzHZx3Z{^5wg<1Lc0JWd2>zepqP;eaE!luVccO9w_bzY~>tKJq< z>PZoJP>G$qV_o`zd0#)|-PXh_?hReSrOY!+M@c}$h(YeB&*?{7DRqK(=XUt3)nJ0l z_I8JJ^4whwSfJX>9S3jgtI*Z!{Qibgq@vKAll^j6phN$eqlq|BB|+q?X~mzxmi4YE zs05C&-BiF{Gc2>+w#Fa~BF{>_3p-}{^k`{$zR8BYh>SjTpw&+y;e|Xj4MHj$?y%*d zo&J%gpQN`u;gcWK4XR|%If>JNWg?yV4Lioa?E_ z=Q*5TSM^*NPv4tU5~yq890%boWHlLM{n}gF4Oa=W_5Kw=Vx{>M!7j|ueYA*E3nbBP zf5dPz7_)D6wYRVv==i|rlRtagcmOqsxGXhR{E@jCxeXat0@Oj9)BN z|L|x&b$i=he0j*)ukfGWMpSDrf1*F^O$;2evqx^N2J8bJ5qZ^DthTmvruEi!CVNIK zhsYb+D4f(Qvxy4{oG)br!xTPdACmf_cC`DsbvuJvu@vR;_*DStyZgJVN(7a{L(#bZ z{s=ND-j_&sQx$hiar#1cRu>i?&Sa%t(#H!GtIt~9%=&L8xIxFiChh+!YW_VD8R>7ckyzT|;YU#Uy43~OAW!smUYWE87Rk`*fA zc__n3es)~jg)Sk{u^EB&FLJ=dRm$~stJyZC3dl%9NpHNcvvb<-MehCmoYo_|h15(m zCfxj<}^Gvh~F^QrXA(6p~TrQ zI`8G^phBcy830-SO90Z<=a0MfKH+6z$z!;ri2%>9BX*8Pn(jh$N|wC z*}!_na-M0L%_KY!emP|<0)T1_jc8x2U&vjQSu8>5#SC#6$&Ma^Dkm?q?FdS^sEJ+) zkvFHwjCpToiMf{y%0GN$VW$JH_n5{%4t09d-g?I1P3$?@)kkPEogA}*63bmn2;V=V zH=?f2v^c5U;eO@Pmn^F3^20R6#8KYdaiQL&$r%c}&Ae83HXVAc%*UXsFeR~VkS9GX zV=TBc40_)T#fy(P*b;dDlrWqg{3c-WYI0Na3t($&jLxps>)PWNcG!=$`rh@+`d2MP z3g26tgC<#Z2;D5pFew?)r@g)G=GT56`E{Wqj;vux-y#2jb zDBh_EWOeV<6s$i5V~DlNp+_zQtle;>2pVTV)8&D$f0wZS|KJkeT;Y!_H@S~(>F4_UuyNtZ@%0q(=N7#hqtV zlij+mmjzG}6ctb~s30IE1gTOYy@gKbz4s}^A#_6T5CYN- zbw|H%{aNFjJ&D4yesjbsD5cZ9-OH8xoBGDYAaPdtf|IfjgyKwZIrAv9cd|=FiCFQUOis zB^Hx;;a|6_$8rR0dy!@b0V~7_;=0NOyK_yyUW5V@qU29dN`MUKt;{x#tvz5`sf%y+ ziFc;6TXj^_nFtCJZ>&!k?io}5HI`>*s~%^O0q0#v&ElzBX%}x@nij6ETSTtOrq2?aCYez-D->bAG>zaODN`gwtM9D1QLvhLRrLg zh_xPillCDZI@s@#3!jjVxcLT&pi?pu=yU%$%PE(*O%IP>T3Jh{@z+{aGYBrGh!nDA zwynJ~O*tXDs^p_hAOUJ4eEVx*ET%Vw$nCd(Mx2-J5eo7N)qbh(?OGS>?Kho%3jLXY zrSCIoIeEpPpDTkbvGvE^43Lf2jdpTA(}^QZp@o2D3S*8%_FhifT1HZo&=4GYcj|{f z;_Wy3-bF{n^HYNrfsZ-&p4lKcRi=k$%nlK`@=fPGElwa zOiNFaVu;7_k${2p^2TJ*x1vR<^|0q@E z&%6J9B+EagOVkGgzCwKcfXPjO@Gwy!zzlzYFXB4?qo**}L)tgg>G;bQt4vj+Psn}K zXz&Pmm2TqJSgcsVM37J=5$oLhSgbPSf&#o5OTlKBeELJ%+2D{<-nd2B?*_}p)s1(e zAtn8n@h=z88Q61q6bU#Q8!v|-?~hCmJBIlx#+@`cuhbcJ-4w+WICp+%(LU|gCMz9X zU1~5!Q26+`Fa98!&PVosLulud={+ZECb?Rz&45{;`1Vh0tQ5<%?99O%1HZ0@>NiAW zhUe4mI^s#7iN5y3hx7G#zj*P0w$LMFxKgHOHTXj0Ncj6n6Nkq67KR5H3wwx_da?b& zMz|z@mkpWRvXuZ2AfHbOHr1~`A|2}9=}ymmSq+n4f|(l2SB4{hXpo)w*S5~CArE}B zUv+k5O#7ZH*d3>a(#_M@4OmWlm1|yL95UomZ;QD+9QIPyaXPT1Zj=!KrU5xd4ktMa zL*W0krDIt45PG4^3VdOj{YC1!^OJ@A-+ofDZlv0AipUR1ct3baU_$i0=RI)B$rB{D^Nk*j$uqbpJSH;8L_FEBw0y*Uz2kiQfVTGzvFeaknF)F zIm&gxjc1xWtG$6O_BXCe7L2rI;4A{m?2QGhcP84+xywytCD{oUaDOh2 z7xWai)Q|VO^>-7xLci!?7gk?S%stO)touBfo>*C z(HU1z%Az1x!v{O({gkU{vxV&axxw9Y{|ooi998*-ew;VivCy_I^I5ap50~nYR52!l z3}qPtF1dP^L$UlwqdV3Qwx83}vbeB!p@NN+)>Exi73m60o*f`B4<-Q8npYW5;-k%O zN1}ha)<%wsBy(YNy-qauFCV@W-(HwmF9Xy4a$;b8zQLeGY$tO%Oe)qtmaJ`pRoi-p z!rB*%Nkii23Ok-+evMAvq`l7Ch3vlKwKSds>wGM9rh$9+^G%2*(EiOLn17^Cg`Ek0 zV5>{$*0S~|F0AigoL}!;PttI{qli8pM1RsiNc^;9w=lyMT-buJ*W0`V)Jve)8Cy@+ zLsZO6*x%*dSF!&&g4uskYyWu1zXkX&i>5^V`{{oirS|_Ykbi}^aoO`u?J>OCni4wt z2>Q!*W;H4tcvE_J-&O@qHrXbQqPC3bmg7ep&aWMP5jvNLuWY%3?jXuAIb^IK2GB}F zx`h}Y&#lk|Pybz|cw&(a?vpRA)ii4NGz3UHiu=q?fmwxAZ4zh zl4Am6abZeJ2=RPRX0<*HLaVCZxOzl5Q~4&$sqw&7a;Vq{lF?mGDYHH1ejq_MHfmil zYZu=ie(4Hnz0GtmFBi<3JO_9$LQF@Yi!Y4Wb5s}K(WNC=smUMfOsyK7sd`NPp-yEX zq2iJ!g>#4BVY;ebp+fXwW<~KQoG&$-uXIuMCkib$<8h>}zPm;7Va}`aqAEg%*B8gz ziQ|VX)D<~JUH(CuUJ}ttHhm_g##tq!cFuOOgyC~edjj&*0&M3gx0Ys<%#+o>dL%`K z;}*MpJvqooOT+%bwfg}!=6;>=%Fy0Nm2`!P$$88gfT)*wthivJ)qn0(LGc#HdlgvS zfhI10tTmeki_|FPXktzAo3;gP6lGjc=63~_LA6}g2q`-$HBH;C&g}J-$$bTK=SkTR zfZ~;>@7-r(9}ao2jKPHu-(I_hrDDRqz*0df=Vb+>Q)z%FwV7dE9?h2l*e~>>8GLpF znPfa3$$fll?|a3X-r1;xIW*fj(rb^^kTL(Z&ZI+X+9a}h;j@OtclIK~kKM_H+z9Rx z%QzN)rP3Gry>$6KvgfDg&&&bV?{+Ih9N*r5b|sj_wglcyM=21Jmc<>3?~yN(*%!X& zFC9Nh_7XeeE8!I;Avd`=6WdzMt5mcFtK}nc`D76C%buXrurVZSbmK4U+)y|O9{Ola z4S%)^w}mgw9PdMWa@lxN9D_3hamHDyFQyGGg_{o^lxpSS+)8Dl$2u{?&+VXfVHe7& zaTu4ZE6^5=4ADh&sZ6koK<=YSwUxU!kH87tCWS(&(SjMCd+GYLe+D1Gt`8uB0}dXP z?A`?4z&{LAxO%i4gqJ>fvri4yf213Eu7?qa-p0Rjk()~di2%NdRKVu}vOZ5t>U2mE0?tO`e0jqCz72}CDa4(OUA|Lf1 zu2Qven26`rwWVD_^LOj=OCvIon$}E#0WJ5cD0w@$ z@h_PBa!!@M@hN_s4XFJdr5|2Uxi)y*I?~OoGqK(hDg4BH3QDU|GxWgr{oT(8+UWmn**RNpVH$+xyz2mT}vf

CzFpbi?j3xirH1uU9RGe%gm)2=lZ4G97gMVJ4F6X)tL=kE9Yj)O>D-f0tn1P?^ z-*zuZ&Z62obNl2FLph<2e|AMA-^M^vE&PyoT8|+f_rB9YVB16K64G;r1qvOr!!@73 zWUJnO>>Amnh4S@}WvPj8Y-}>BPZ-}EigKMNVei~(mT}5!vzpl?Nqr6^Enj1Y|MsSU zIc1?JFJM&QyiGOL{Ji%hRSPLVSaN!xa2b?Henxnn<^mXHc*@WvlnGdOB=@ux8|qyi zY?`T%wm>NLis)_l??bL~sTar8voQE=8hzgcxAwZTV_)D5nJ0E#dRJy2(rymTwablG zKigkX3-_#!yMP+)0`-3v039|>WiUqXZz55j`8K_B&OP~G1WHJ~&S19fWS0Y2yM!9j zx%ru2=&qX9;z^Dt`f7iFd$1Y) zYJaXroq>(7Fr&o=$^lKpm8@0=Is~!^a#}70w=mbUFP^_L& zWV>`0~4mi=F=bnKHXcAitXloKOpk43WaQf(Bk4O1bQP{Y^Mm`Rcu|e}7z7o^` zO_rBC;^Bu)uT^@p)SwNq?W3em;698QI*-PAdGPYH^2`0`u4+VX0E8`2y~{BmcXoS8 z%lVE~o)l(Qs!O>*bo^1;O|&(0Wxt%sfd4_8UD_jPmn-8VmZu|&l=vN=k?EFfRpJTz zfBYj4>*+oBMe{lF;eR>h^p7+*edu-V_xskF#5&FU`$NvY59CWtBew<@|1ebl;X(aB zT)2Lyo;^`PGFGX9_RHY*?^Xw*zM#b`hjhUZWNtDf4L{bd5bA7~PIThWhRVKf6;ov% zx;PGez}7XqtpIqTK$^Bqp|p73?6(b=I2`Doa^P^%`*GsRfSx#f zuW&1ig-PzErSY=)SbxeR#ubu~KXzUKEZ|kto<(0++)uRThWc@i<>LVDf`TIAh%^8z zqZCC>O-vVoG61vBI{cR>t0*kj&q?ETowARwn-!zOr>4MJ+$R4iD6|_3%w$gYcS7y*bs6 zn?M(0w!cq{C$REu7u!ES2crpP|f#r@_v-tRUpQ#&&2rq+(a5rJ z9r#CdOzCR0tWE@J33^cA)mOcDoG4?z3(P8o~`>?TEYSL%mF-@P;LLZ^y*xuEd?YqV-i1JP_=cezuzOp-0=L%i)H^}{nL=g$t!PkpKTRUV$`E7x7J?CX1ajDAz% z$eP_CU3aycFnFfVE@GNs#hrl!`d|n)X>@E1gxF6jg}McLp_y zuW6vyZ$iwnB?>m)pJ5|{iV>24qeO7|*NKLi$9TssYI1a5ZNM@#f1MTxntRhJc=lfT zoA73jgYfGY2MFI4G>B6Re%&}{A%>R6O~M7kuSJ#amScz^=Wm$2+C7QrkiwY~uL<>4 zuC?$}w!n4wiekkmNby%?-+pu-+aR0odJSirid?Agds5VPR5ERz#P?km(lg<+XFfxy zdK%6!w_&rxM#jCdS8zbTseaPdwM7`o^9wN{te88V!An-!TtA>r>0rrGF;`*^V|6a7 z$n^uSd_(Kh2g)W;8qRvSLVg4NsZOSeLn)NbZIyl-eEqO_#|%m~ed@fg(n(-6Hx?&l z;@i@Oo?|YfXwZj=LIGe`pzexWEFTR1HSAtF-zHs35l+7^u(6P~-aJ3BU3l5dMr?dm zud1IZH?s3JK&wz-eAa!QI0Esx#9Nh;w{qC)0QXO%^oKm@#mtAxV}2cLq`VXovD1$a zluK#_I-~bhVh-!EK_w{GR~0?`6ISY{kV%dk&v&pKWvoj&mKL@Hfr$PS{hS{Yc$!XATGUU`o0Tkzp%xIs=<5Ty*^0>$V~qn z0w$0dPG<4Ud8T58*h%#)(v$oJ zO0rS)Zv9Ny-YJkiR~TMo`Smk^y5;+R#|#vT-z;hb^R+N<*d5#Zlm1Nw|G&`x{v}2I zS6BMaK>6QCiyIAF*RO&X{!cwt|EtUkZ}qJCoTCW$)xHKBf7R}0h_e3lW98|hW0CNt z;)oU^h=NbS!Ppx#lN?RFgI3;)}H%QPl_TwkhAi~Y2ilauwDliHAN`2+z|`{e=nt+Zw{_Ymde!n9AUxx)CvD}IsjUhU zZ)(?eXhDT_JT;SPHBZE)YQwngk7c^Ze-tw*GkQe~S%Q#*n1>0keVT;m@a)bh{^^(JJkOFNe*mGt#Y5Jb)+)*ZX9 zvY5d-+oj5o5|)g%Riw&lDQqU5*uzZKOW6G_h0&x0u-SB zkDjXx<7Dj8$&?2gkHPGdE2T|Gh5N~@OVe%L)algn%*=XrH#)Ju;Ps`J>)Ul(2pdVd zX6#$DM&Vw({*8gIu0z#tZ=7#fJ0fM$uf4)zoQ=D9Zz-0=4~H+)Kvoz&GAkG-qX*!F6iCL^oIsM5I>(}!^>q#2(r&mGR|eim-Q07xwBKnQEg;r+9_L5d8dv?(E8kW+HX z1_v3JB_rg$VlywgOepBl0qFMdK!NyI`a9ozDf}X%>eYUURu#GgtzU`^2V6Sr%gkJT z!1XvTGhlG{a-+ct4>pBQu5q!fswIJ{`0hH%;gjX|rb1{K`3E%8;!t2*%R^(nvkt71 z1Z*LB9XwzN9dRIrCT&gAa2S$48|Tb!a*>+ThAl1det{77>(wX;n<%OPR2_hpcwq$( zyc!3liW;f{WH?eTVinJ*md`!%>4WzijmYN8p0no%#bppz(tGzK5}9uiMxF6_VNu?HcchYkQVoBG|`nr)dyX^^Eu6Fd-7}R0mmVw zSEr4dQ9x4}WEoHBQwXyRZPix7w_^8^ntYn{oyN%?CK3{dco8v61<|foAppw;%W$7A&-WK~@W5 UagL3q`qN^qAfqCUkTiYwZ=VK-r2qf` literal 0 HcmV?d00001 diff --git a/inst/tutorials/20-ensembles-of-models/images/pic2.png b/inst/tutorials/20-ensembles-of-models/images/pic2.png new file mode 100644 index 0000000000000000000000000000000000000000..4ca5c0c255523b1e7f53fd04a289d4120eec443c GIT binary patch literal 32690 zcmbTeWmFtpqoxf3LU4Br-nhHFyE_DT4erno+}$0526uON4br#;cOCM)=bdwAzFG6F zIX{4wqE>fRuiE>%uX}fxqPzqGEG{e<7#M<-q^L3&82H`C?bR=zKYpuT8H#=U0e4oG z5C*H7#6SAD18FWKCjGZ+|R-`^kbA^TDjFfcy}DN!L+cl|%F zNH!`Ot@jar2h7ZF`8(kSqJQG9UC|Z17`K1s6)Ydi$j*>CgbFgGW;-%tAkIh$FOdDF z0GC6Z>@l*Fat}>ybextMo{4o(aA+paWjB+Tn)aVd>9OdJTg65QZ$X#XYnXysp$?zg zb^8`@cdq4SPZ@2@g9s@(dmHB3e!ps6{qDtgGF5l?6esB42Xf%VpN!w~i}T~cM-1%) z(SkP{9(+88Xb#f@#q;ri1EcgBr1q3~2;^hrpO{}i{2 zU>r&>d=cd-g$)F?G#!SpWv5?ExF#m8#u`}#nHun|%BzwTw80k}pQV0YknL@1RW!2^ zHk5&$%;pJ$c#jQ;D_E#mkEe@lGkVQMrJSXi`Cbgo=XWSH^Gbn!R!0iZ`Fkelm;EkE zmAvrFK4G9?J+ZJ77M>M ze%jLJnf#r2`uF4UagI@uVF4Qbcf002n=u>CS01$aUebWni$`JW2{8qo!S2t8=f*@6Cis z-=P)jJ*87yVyu)FE5$pRGI*7RZ-=Aah{@T{tp)#hCfU$@QwSZr9y0oYO&RtMAE>PP zr=TK!si#H+=A4d*0#KEGfvZYjC!Ut3dpXL|?J4d65Sj)$pz{xXEocmXy^<7LZ#f zbSF}_xXT&3bSv4$ZQlSUlfKSFs0lI=3T~BjiC@1lo3zqdaL>bG@daU6S*X%x<4rrn zpCPd4JB+>sjF`2zX4tpAL&4(`;j^oIii6}!@3RM12vl8nz9!M+8fswlsuD6Mk~W`~ zTruLUr%-h}l+KF^^bKiyYgI5jrHatx9s zwB;nha&avPZ~7c*J2cFGkG42CzK@?-7R<6(+|G=J@8ls(+*kc#-kCrTlyC#Gyr+`Z zw-%1U+%xq^-jz>1kp*?>V`y(oqBJ%lz{SJy=bb}biPSr5q`HfW$A||{R>F+CW}}>i zPf5WyF?s0#F(m}qi3O;B>#Wq}jQOI*cfjV^&jNrCQ(sXRtw8ezyP9I#o0t>3#0O3g0ccS9H{24$qHGm)MFqLDDLN6dZt>MFuDkvBVIUU-XGQJJ1g%|6u8cq?X6@2`(`f&Hp!B(x4#P8-?Cur2) z&f~Oh*Q`s5iguxk<_eYKc_T-vH3u^*d!w^>lm+-(sE4Tp{JiN>u92Pq6e^H_?0k>* zdQ_M%K19-&laE6xy?U7T-*)e5tBXfxB$vk9;k>EZ2zDq#`yN48^CFj^lPpema`*|a z&xgBbflrm6EVhFG#Iw45(E>%T%v8rtCRIzm;+*>|W>6A-X8eSe>38*YxZXRZ>=)?O z^H9{<_r_-xiUA(5N^&1G>oRSh$FuI*ELyp>XLA#8=sG{^uvZIT7}1yNIBxfdlA2eR z2@@rrzG(ue&-j(q?o3$QlO}jgRrL1=s~`Wd+6_%ED#)!!&c5z*t&iCr{joeI;ajDh z-bQ#Tv@*)5`|gQ6>4*>x&+XBvhM*Vlx!FwQy~)L=8fnpv0e$e(?wDn?sr1X~Ehpcg zCa|0FwnD&_BvU6cKSu_n(lz&E5MqM!5ou-nyYg_yks%3I@VU!gm@+qJ8_WQiKqRqv;B(Pt0KRK06?j2lZ6 zCmBLlztf?G0C!JBe8hv$aTPe%^UCu4#_Idc3dVB|8HrG|F%9e7)KvbGhgpTvZTbG= zKb$p6Fb5?RHrmxd*AAG9BXWo?J&E-QYU(UKc@@yf`sB-PsAk4j7JW7B=&um*1{PB4T%5YLI31Ao>L{O3^vS zy#-7{o?VzjGpbhPPt9o)Nun+CpDnggnxn`*&`Wn3$6gB?5W#|fo|YhVZF;~{tcdF7 zjD%JtZ|mYKy(^K#b>}zq_Whx55VNW%wOrgpY2<^DgbwtH4_m>ORPaP*>c)HIkjhZb zrMob{R1zCtl_QBTxj^rmef=rItzOA?i zIvF3trTH{D^O3JN`f#j7&9?9W!|bF|yP4qYNW|f)0eMxzW<|Vs`&FGrSl7qI<$69) z?|RYoSIO4Z#|7kz5R&d@@rJP}toUl5JV4__(Xc}7I?UN(Lo#bfh~q_?U~z^^ugA}z zo*pga9k2C$JXjd4N9jpw4RKw1ge>_nylWW1*XO%AP3mPO{uL4Tuqmvw7q3p0*Ifs- z=BTeSj;SQgU<>d=wZHHds zkxGvGALEj|RC(5m%^gR8jfQEbCRt&uv9{V#VTa%lb0vTnVyYRT`ph z8Fsi-*$LcvN-TueJD12Y0DrX)A846q=2d$kaPTF#9slKO)mo~gTj%4H&4!XrFaenS zWV7B_#t`%Phx5TNuKODVJPn*un^eHo$`8a(J^LnIs2PY~D4$W&g+sSD5Az-tVNY7h zZZ2}{g(%6JIDLN!17(vb-U&rxMGH4`5Y&2={4m1b$}rPep--_&(qZ2iyk;_rg|uKV zv!b}Bel77uaJiCS$(bewy<#`hADnO|mC5+G7Ggg-8Bh3C!MAv{d=qh1ZXbKxYj?o$ zWwP&e&_9N%4OgN+A(#E#1vk}0ulv_F%?|9T(&cy*?I~CuP1{%rK9*-4MlwAgBJgZK@}q)CmQAoo&~z5I$-lT^Qje)}`cDQDXhf&H8> zd@#y|LF#1(O{=v~LTSY5fzV8l%LylYd;;Ltg%3qT)ob&pA)BeXhC8i-%GOSFrD&WB z^#`lnok|93fCf)dM}vZn$T;?^8zCu(7g_LbQ0>br&q&yfkxQ2Gs0P{BpKH@Ul8+wi zPKFDKY+BZOV&oN_B@o!8{;;k6RD6sUS6(E2NugyVIss;PJzdo4&UDtW=>{3d>qgv`tsvbX9qIz?h4F)E;=?s4^X zJm)#?SD>gLE?f68jgjFV@B<=D_9beZ_a#MZuy!79wGa1g`vd->g@DVxoJaKETlkX^ zp>TIty^tBgO#$KLC$cX?dBVGuQ)2XcdEX`3_Z_lXya{;B9ZBpR<~$_A)M(nV-(qZ3 z|C9mW)E<35wVTTVcr(JbqqJDuR;DyVvj%MddlTxk5a0lGaQAof&sXJm(--vXUi+K3 z_kH@m5adMQEQkUwk$cCI6brGFFZvkKY0L`GkUqa-B`v!S1Gl4z=dH+D6q;a)Bszu# zyiq3b4r(kFID?TB6$dE}Z1H5=vrwmJkC%=WlogvNj|q}&haaW*UL=Dk`!epCN#vAO&fL};toNy`o)@&R0B zr@^2Wjs^rLYDnnu(s!qQ7UCR@-&I_vI7v;9dk)1Pr>L$QTgYCDAtXUfz3J4V3pK=d z=X2?Qd{Gbb644C^a~^i2JwC7LSF7qmP3A%=+e9A@328BpJ!B18|2O_f|;DgsB#n} z(w2Tye}-mqZ-vM0IO`q#-gvjx9Oa<>KPApFjl~Bk(p4eq8dyl}yhQ4;JT43Z#@4m>X4mc|JzQIqk<4+jYf91w@EhN3s1V;Kb z?Ofe+C!X61&fqE4l_BZYyt?7xgJdgUk&Jik*$b}TX+zFTANfgld%8#DZ^VyCPAdQs zJ<=;#j!2$JO?{8XY^<;hnRWs%3>XC^q(lL8bQVY0{^ps%!(+ImEW^Hw^7wq3{-qR2 zqQeMlAk2D$8%0E_*v@!dA%Wt-lp{cTL*HNEyPHA2FhdD9aO`=bWT1GH!QqxyCC=Ex zn6o~#6k94{oHan`cK#Sn-pepUmUeHl|GcpRXnBsOeR(8}lt?#Ad-@3kJ|T5n@GACP zWSFtqsEG6=V&rh^61#WuBA%G{DVkLGT=9Sd3@&@*kC3TydSv8E-|BN-ia&2h?_jT% zCuEZcF11ZN6%uW*LZR<~L;5~hvz{}E6t4vqi*z{fk;%{i>{Z9R5G**gLQX@`&yaMc z83q}|u}Ce`VrPpIS|0s>a~B6bld#26hRnQw|LjW0>(BfrGINhsJoO{P!9?s6ww5n< z*opJz3i6-6H;Rr;Nci9*6H=5re3okDC-2%B+DI21U}g+GoblxgE*|D2zCFg>`wl~} z!JBcp!($uFLW!?=t0siJQ-z6$s0#xGDiH%%H(xl!YQg%5HzxrigP4ba4x_ zU|)^#Qy?dt_S&3|j|1nuOF8|8T7t20JvDNtf2lIiaW)GE6k=K#YurM-PDYVQ*Sm@Y zsJLnnywlRw5PeLD1T~6!Y@t2z$6i&QjkWde#SCxa7fc@+-G35(Cv4r2ex#RpJTotH z$=PGK4OBnB- ze^8g@Ucyy*;J6cinzS`lSEPx8)5}>`ypD8e(e#UWDIXkW*n1GGM^Oo2b2#Jg>{LRRG zIavll;ahp8@GVi56R_K7@F`0cn*v)u5?DTv1=@BLME;TTOfdSVM zo|9Km+IObsoDT#eM+%_HrJ^cf{gfGM;}E{`xC`p-;MZ*HP{f9d?GkQ{`HNBC*{RSW zfTpXyMZC`~yUkBo;;e)ggCl;iF5K~GXt!)S=YT6*`#?I-@>`l4J8=Hd5kCIO1Xxp9m$!Ck1IJ#V^PXX5|CTj!JeBD zac}Ea9Vy0C8C6dMkMkgs4RlP67OcaZk7kJgfG&g-I78#CjS$;*eoeW1p=vS{6qLJuFL9g(*^|C{zhscIwfR{)kCE zj7p1HpXzz_^eZ70si$_OPfsaQK2Ji;Fn>d%j zq=9MW5qe{IcJfA4Dc~tt&x<(Dg`~UD!Qe6)J=nK`V!Rj-jRbyknCrB14y5;fW+k#p zj_$KP{Pw8Nz2KGg$Ja`+Z~&}m!zGQ#FDHAtiQXM;&r;e{n17Gf<0HSNCy)Ys_v&OC{`la=YN9{QIr;!FFWSoBE_077DU z?%HVZk{)CUOc0Z7%}M?DX%i-(2%2Y*l}R;6uDbyqJt0kjs?@xH-shR~n7*WAhd&}% z+%YYM4wS_4IrP;E%s-HCx^HbQ7N4EJ{f6Vv=}c)PXibV&A~Cz>c)exYer=m$CKme( zTcaLJeBWBK$fS&ipH0b6-F721OPd6|(vami1;GBkbAEL^#Rh%w1K?Of@9eotcUrN; zBYO)ahHFoJN<_OZs%}C244F_@=@CK9jV=W2>}=kqM#RKbZ0SLuoNh)XJ(c(yt#sdv zFduXO&(%A!-mLBGTh-gME{h?sc|g?);w|%kVU_;C_c8sOVoODeRVBfDUlw?pK+fwT zG~yKl%g1!o$LH|9BnU#6?C)|g@%1T!ZY8*kN7Oaw9bP&8*E?Y3S=>je5+Ty{2t?M- zP=OcbBPw4;H1#6)QLirQ5gLCGLg+*}9DdEr+pF7D2#1S4i9>1+2JssKvpi3pHbu8{ zf>&Pjw0^A0!9q^0g2EFiTm5cnEXf7tv?PE0SMWlbewb>?O{i7HSJ2E8rhwb&f<`G6 zPx^6l{(8#^@MA0WOcwwx(CK?wmN@-M!1-rzBL!%(eb0CdoDet8zYF^PP*K*2{ z(~hY@KrpQ+Z&1GP#w9i-s=?)^C!;uonhp)mRRU<-`0VIFw2)t+6BI~b6-?MJdgP9i zLaE7pCdA|wP3Puy>>#x_&HZnzicR8=ta7$t>q0#~W_Kw)Ej@GS?n_=^s&m7e`6XbW z%RHRiM(}b7$tEzbm@uzjR|%VRZb6Ym@cO?2mdHqQn;cvdc+@*d%4MNxFM^H~oP3lg za$*Xj-G&b0cQ^CM6(v?X+03d;AQIMTCX{%1;42l(bH@eUR4_N+ZHxNkwlL}`H*2;4 zqDXw>m(aTTt&brPN}R&w+2!VaC0|hqDGcuWhyQ{6xZKxuONMTg`aSI#WfJkC#q__Y zy5km!A)2G~hHi7=Poj#X%bcZDV{ez(a$I^CPa;A5PqB27=lYV2z_sXC=EQp-+STEMM&nIs*>htG6h31S{MqTH-Jx$Gkgsm%Z&fjs4k#rR63gGvh z&qnm-^NsL)=JDW^G`|Vw{X%WjnWKqPT{l{re(L&_=WC2`8b@b}#kfMw*Zg4l%e%on zZd)nX;WXO6$(Av$W@`N$nZsBLr!mW+{WW-HpB}G_*yJ?uz{8Ku{x^*E?N|0x>pU+d zr>sAj=InVR_T6#!4TgA3Yqmr?9h6c#&A}i(dm)^Th~jwRUCV1lk9jVip@Djv`M0JC zhcjm5uQMC>5#VZb1TIKsM zy3UYYUq%7gez$P7Ii$PZP9mKwVq0TYMszLT_jy*jmnc;e)~&n**>e?JV_-hQYT=Wd zp^q?r16jLi|BKFANI@?@aimMqhoNcwlA_g2As(!vwtLRN14J1SwmO5Phl6%I%Vop^ z8g$ATO_qI3Rj)dLlS`G~xHY^xH9uwgb6#RQ;}<#!KVH&|DzxAi_xn&Q5Z%DADDO^E zQN!(StUUwAHpk4SfG|eQw&gW zYcdLbzVy2tz{F5YU|t<3n6!@mw9sCZ>pZ^H9s zTD6 zwcb0E`=1gnRsyMyL!sMyJnB2f-Z0j^E0IVyTA=VNhvIk-LE%BcuQq7&sqeYRax0P7 zy-NFR+vPn%@Y(c1W{6&R!RPL!g@d4mZF#ghtMdA@~6rjTZ^7Ps#7`N zA_;^tZ8n|QU@~4q@b<~n>+^(kFXmbld_Lwmk6+*2Zj3gHxCV*}W*~RV z4sqE%r|;9OLs`tj2FVMrYtIJ%nw8$AT)`7l#b0Xjn7mAD@YxdlTBfTw@_cFo&_eF>F>c9|7>PwlxBQmVu_C)a=Q1o~&pX0h!Kuv; z*|yCuIHBHhPhJMRF1@1b)zt!D$wm>cx?2??2#%7m=1TjQ=w@qs3yjAvn{EMT{UGp52HxpXMp1J zs{kApqgGwzdXlrTMTNxb`=M9Yhd!rc_FWg^dj;Z}?i_Kbh9 zJY@H!vTIfPhqD%wH>LCv zHdm&J5E!F}=D0JtBSlH)%0zwx8N?^R>(YKAYzeQ*ZY}7nvB%z_Rmg1JNulj8g@=L$QdWA5tq}zPe{Z-&~YOh$VwZc*cv*nrOPC66K z2dUmye!uj*gU~{z2+^K?kBl}bG<(0KPS+l!^sX8#z?gT+o4Cm~zfA4g^XmN&13Ula z%sGY52j69w0NKxsP>*+Xug!DXL{@MRs2sYQ5Y=sT+=9eCkj;JfJ&&EaS^!TV*_ZVk zCpYE5H>tX`f79J;K^PwRY&Zl`Q(T24u*X926inu_q*=1I^kWJ_1&mo-xYSYR?j+mjK`xiF_} z$7oDiG!Q&PLq6*Lr+&({1Md7l7Q3iyM|U@HC;Yy~9t)zbB0%arsBL&+T4 z+@(QH{3a~=A4bVm+R^WT_j;75A*%si1vZQdp?IA;r;b6`>Hr$y^a&j)Ffc3}Y#{fB%BV@#Nj>ygh!_glP0uZ;Nb z#^X|}3(1mxNg2vX=edSLJF6VHSX}6S*2nv)jB%{gev^=9+;BObjou)xY8p6nRE(Yu z2V0?Ci8bXJT8xzSbC+$!CR<&omvYxpM78?GnR5JjV)jyrp}o8;?h+t+uXkuH@-*i{ zt85BcB~TM0rkc$lBXP$L0joZ>&L$1RIaSB>n3DSvWa>b|-u12SV&Z*F>O*n{@vx@0#GtI8gY%0g~SAfc)#Tkyj;`kb{l*OYN26?{cFBytJg z^tv!`?3S`uPEyL@d|z>6XkDAxASi;!FLYDoy)?Wy=}%{iK=~)vozPhm1D)JT+@28D zOlid)u77|tW*9cVN+0qp4LeTxK=e#S2Oy3opY_perTmPnw&mBIL z4faOHsTNeDwT6^9jH1<&(kN=v>s%7q(5u7d4QXbBbnE-q2S_4OEvR*M3hm4b*%R;( zP}fn2fWA}As*-)_aw zyf>9_8=+IAHZWg8kw>Y;A8B4o8Q6L}C1M(#^#D3_n=wO`{PP5VgqLQxZ^B2z`*$SA zM1UOnF}A=^FdY*+4Xixa!3y9;W4?(?sJs&6vXdNfi{jdCH|xa|U?OTM}B;Ff4c%!6G7( zAcpIoMUx$D)GDDRlZ`rsJng9jO@mGU?IyFMx@v&nAMnx5Jo)7+QEgqLW`+5@1nm%5 zQ-0Soig$*U8KRN*A>!sLNt!9j_{k>fToyLLoPA(JrQ1()_i7|M$`Qww(^7p?qrwnU znC@vGfm#-{sPR~@bB?|mk{>Jv(j6+|?!$;{bj1^Tvc6Jg3eoL}b9kwX%_gOd^ZBV~ zD*|?*G$glWyx-rVd-L51jbyq-tSmOKwgqb80c&~@z3ps@)nB_3_9l)Imc<-rPA&Q- zImimW?lI}OmuebB|6##}N+hIxSBuks-QJdv4U*^o$cMq~G#d~PtCuEq15pw1w0X?L z{wt^N0W_)Ls)q=dU6XsC3|VN+aVddhI(BO7e1SEaA{~fk`GQZPWbCN0xK#e zIf)If&3VJ>q%M?@-;KCNIjks>g0W9kYCe2ju)aaio}0I-5V~=UROrp2!zP~pUV*x< zujE4CgVW)t)y#$69satJOrG}iJ3z2w^=laMHy|!<(x;3QPeob{RTiU@lDbA=Lk&Aw)WxW=Fj14;4hKXZ+CXk z>xEafMK~qahn^pifMhpgS_v8P+yjFXckP~C;u&Q~X+UyPSR}_XGfkgr`wODx9Y@}M z_NVmIEQ^O9y~T-F5A&taLRO~${l(m$Vv{kkq70-d4Lh1lz7W8HEaT7 z*Ntqm0EWkCq*7>W`lC}Bk1-4tUWzvbqQzdWZ7>;I=Zwf6R_?|bdsO~<77v(Ix%BB$ zl(6KsJz5Dg6>c_)9JXG+la43<7$$w{gg)y zxo?Lu9TZNLhK+0bg{mi_l<||ny;jNliDcDvIAz5BP;gEhHGPoYeg7(L@lx^1miZv= zG@elRrCzgBTU*kRMwqkK$2NG4Jymk~;LL5@!{FhfkJG^0Z`OOCR{HNtVeGxwyqc=T z`M;QB@E$le#PQ>CM(&2Y|zQZH_h=@?O!*T%d zHUrotCeAwMN1H=NdKj8vYyY%G@9iA>^$g9!;$6Gbov;u!Wk5Q!8R)I=F0~xWSD^CT zS`v)+2X74&?z0bbomR*BPs;Ugd2IG?c^on_@lExFLj;L(RlrT=^QHS~Ku2GggB?G6 zJ9S3cqS3Wyx5p{`@A0Wvh%BN60$cDagM>zZMGFq&woxRVn4olYnaHJZ$Gg$5pP|#^ zx`f#?Fc`!`c2y=>g#Ho6R0i@XLM$l=apDqN@d_oEqL1TR6(5#C%f-FwJ^&%RTuo`s zukb$@{X&w0<#92L|IRR(+G;2E--zxNOFii8sOiGRsFi2-HERXOrF+1WFRa;AWF;UV zn2+`yie*%u5`H~`R1RhjpMCNR(h61&y0 z1TfE3Qe}POu#pWl42jpn&UQANSLNtgH4>UYM1$q1eI{;J$WUrsq9`^#2gl^+E@eV< zBO~Q*Z=Xk2H>tEx9x2cF z%^Cqcum+4|=qq5var66>o2Nc~#CW6q^&`NeSUr5qlwK^UYG%#obSgckJUx5i=UrAg z?2U+Bdnxj9Xlg2?6Z1oJ$ZEH|?AiKLe<-;HwwlcQQ8yFKRyk^c!ClMzT9o|u-v;67 zbKfSr+f_#KuEqA<^1Ug93E}$>f5QLH#x2L1Gu@%!uCLK`=y6RwC1C0kHDjaH{X${U z@1)OYgNFS#q5BsY6ON>?eEGPl?tkIp;u0>GVMjHZV!DRSo1(-UK(5hMKV%Z(x6z)OyYe5R6=&jLMt2ZQO+EZe?MhCKIbOtdbuF`e&q6oIQIzw=S+o0M zJpPuY5*PGM^U!(%~%iyb;Q-<2(_LWK_6 zWOCZs)CJ4en{(o(M&-<*e_FrsSyp-H{CeJQ;(#K~tVj7)O5S|dry;E?1;nw%O+8F+ zwD_5R1MU$5SU(qEUwz`$G0VT?efhNrV^3r0OC23N5l6VukB71C+T^R;Tk8=abuGtM)ZpJjR!ens@LEs>rpMys~@tcE)KZFhS4e6T2tTo)M3KP zu1J~Qz*%tWhzZ|5Gzk(d&<)Mkvoah8qO|Ow5;_@v?Ewh#s-8E3bhCpz&pI4@g!pc& zuV$S48OxAjQyF#n=p3R?lx*gOMo!Ib#diY4S>0Z6SMsy=x+6g=DK)&Hc1sG@^s+E$ zDFZNvk3uY!8?$lJsjv_caF_aXnK{un*I5_FQ=0Cdl<65!!5l=7Emr?jOM>_SI#e5x z<($Qm89pyu-W_Pr)xmilQ(#%`eZ~J#fkhKsjR9U8rzjm$-x zmae8aBBWSBFWwR-U&YqrswZ8uH&&SO=;2w)A?*y}Bgfs+C#s+vKDQNHray52)O*^5 z5;b1a2lvhIm_FgPe74c&!jM=vu|cIuUiOwRvLT~n&*3YXsEM*NbeC|AQEb-={zeCM zdxw!a2qqR7n$>1V0pFuh7WO=c?l+k1{X6rA>+^~ZCd3=fa%JryWJ|>Mna?y9NtQMt zE6>am7XJiZI6j;>wOt@RmHQ5B(zO||gF#&Ht%!6|BFBi-8SG70mlt%5amVw&XyU|h zMe|s|69gLJF_m9(5vf-OI8=GT4NNwymVy85a*|;-?<>|GnLET`m@EHo?_ME4d!lK-md9p&dy~uS{<+|J zS>a|O`Vy6kN-D~pC=CGki4by#E=&lx$peoH^xdgs(UR5dzwZ2)as!dcz3_bQhF17U=c5Uu0csf#cCltQ20wZsr08IJF! zGM)V{$xx~+S4z3RqnIny=lyE^;yJ)*~f{zsOqU#t5 zXx%>Jz^81zi_53?G+C6yvrx*9p)LQPj9KKPYO5sZ^{ON-h171S)@T*sYUP2f zHoUFq6ufk^&B!YLsx+!E=Yhn9B65Zl}JYl4P25{YI@1jXRjA(1vLpNKAMnFBp#U`xKrNL}mPZiO#k$@G@ z&4(1XabiO+2J<+<`n0Kt`ZvaO8g8z_b?@pTkLkTWk+!^YotTRP%tCpEaQ4rUK9Sd1 z=FVmx7A*Xwl787k?mC&vS2?CfQoO;Qx$l@&QXQYj^|irwtDn+b(yCAoT+VAB7l!5) zFUry6{l>#j7e&dc5;vl+A-0bSwRo3dgHhQWRzK^AqGj(b{4Epj5@$HG--um#q}9*M z+!k|>ltu+xPqU@neN>2z_!PM6I>86*CuYqJl>ApAR69esjoMHxxj*`VN}=+j{6J-TRF{BQ)BSC_uM!_-+(_vcvQ=;cddJhyueiZU# z^!YjAGKiQExF0k7w7{B;7Pxb}^x?8T5CG_-e3y#x#|~=og*7-X7FX;%rNFSLLh5!I zVr^1clgK7yPnPtmU{Gj<8DJfX7jDBQ>?W*;m0aLmV5S@Zc&Q{<+;`Q@9`2R_G0sEX zS^yS^`Lx`zZ3v#trCHzE-!i#Bs1*w!tPuA5K@w7D)@3;oO~jv@1`WqvQKYyREDE0u za>WO3(mMwshyrqIM@=!Nv2QThsZz0^@s>7xGuCs%3FsxBzifNnn0OdX$J~UFE9} zT+6E`WwhTu@BkdO5P7g~R@yr_P$^#20hV_3kI zS24H>J^k==T!0<)Mcsm+S5uIk^d+C3$kN>Gg#Vyl+}MSUsd46LM+@#B7Xjxz?!@;- z6sYRKDRXu4WhahjCfKPWWYt8Vk<|<4B5UrU+=x))?@DrtKVt@eM9te@kaM{8BE=M81R)mlg(`(>(EXHa$`Niw4`(?9jkYx(SMiX7LJAjBPLZmV4 zf)fVCRMyh-P%z;a;T?wBA(u+>EN0L3U^80sCmLq%$$Xmzo4aL+HTfK#yt>|kHJ-)|UM7o=`q2E^>DZvY2gh;QB>9xJ>%FcQ?o(A;rJ9thCpawv^+YDU!y+lL!kKU}rd zs!v)H7R*y6aTVpG`afuJ5ExtJW~Pj2Hj%UZj)&l-GauUsfdf39yqNI6k=z{qn>@-5 zF(ZA>5Hcd98KR#&YA{1LWNy6n36$ak^z_Y%L2gAK)cpXaW*5Eq+VjZT2*$!(8b+RvRn>YSzsyK0M3{QBf?FF3VT_BChI6=D z1j0%=8y(RIv^D9Q4S9Y;j-jx~>cA@b^#Zpbuv!u4Wz0;f_e)uhVyW;D>ByQ=g|iy- zVHSN%0W@)mr&q3SJxPUeD3y^Ke@UCos}b2_RW}uJWx&WWIV4(SJaUC5Xs%xant(7oJ$hZvSb-z4myRZ9GkeD0ai&G(q9fEHVkL z!cI$&Xh8e9WZaQgFGS6sau%)Pt|1krdF~m9hpi)oPJI-Ez!nV{FBc&M4@QT2LequB zJLplvRqKKOj~yQqf}?$wGog6SNM!si0?}>7raER?U@>f8JWeqHob`h%qAD6Nv6RMb zB-;y3!ch0!buqq^op8PMez^ahZ?NxtfL842F#P%24(%8zRjILnaM3O~M_H@1g%OEP z4G61M4j$?y%C2d`xX1P1gnjR0p_~r+hoVD5o=D-b_b0&)oF{<&BS^ujm2OKxO(rt~`>dj;92Y6mDp3s5F?F z!~?r4a`Pd0Jz~^=sXG5RDFr|-incxOg{<%Zp!cy(b`9_UUzp!<7h*S>?3pjtqB2DB zWqnIu^r7lXNPO2hdfIxwfax=jf$=%h8vWku#-7dux)PW&GY9p0o#M;W`a*LHTpO)- zn$35W2Lw)}oEH%eW+ro68kSDa)ycbeCPlqy%=n4%=LBHgMT3{Z-CS2ARLhgrPoAdsd39jT#LH zX2VYGf3)@%URAXV+^vcr-JJr`-QA^hcQ;6PBe3a`2FVT5-3_{tkQR`T?(UZQ7W(En z=Z-tRJFb5KW9t}h)|$`!%|}uaeVq%7m90q97~U<97qd-3>cYT5wF4#9A#Bxw~ms zqM~qnIk6s2%c!Oj%E0oFVmMNek7+MGT|DNqVkK6R%xDjgZq)$~!g-;sqQ82;#Wc@l z@Fx}e<#Z4FZmI(3l+@^?Dne_?T93MAZaR|}2wB3ZLKG+fC`*4W@)jThb)-B24y0T;4@I~Nxp)K(+ukm|2WbR@XH8WFkQ$iTPPL&AVDBsV0ckwgtrz=X^*wGyJ z{)8gu4eING?+2(3ErSje0Bg z4T9b=&p2hbd$ZIGTiudO6QAU}5pk4;&E9WEB(C~3(V#%IN!}dI>+2#t*`zm?ZfSa>CHF7rPYiE-sRP{f`&!`tEM@&QXs@B%Yn5JGKJ4VtcY_X^^lV41PU}9X!6qTcH`%rhwWM3|wzibnYM&wkz=6^!Y%k)Zs!P^M-vNFR#Vr<$zw7v^U@#lnHrY|pqW9!49_XUmWt|$8LE`j3hB)x9~ z7Icw-u$f^IMgv{k2GLv4_y0IUry-|5{2xc?)~=u01?w_i^-4SigLc%gC9QSipCHa( zlJl_z&4)q#{hmL;X9f!0tD08^oHCYciZlV96DI}xC)Ks{B@Fe{1>P62z%kBiz!c5w z%&Vf#lA1<8dXEojY`co3hw68m%4N1knwWTrOf{6=EV}*q#2_g^yt(%MHQIPi!U#_W z^g9Cea;TrX^`jJTX$GAk|4|rYs#4fgM;Q30a)nJe82(!PB&6~v)gGBO_ z4W0E+A{J2@x&z8hxJ+E~pv{gq9<6y^z8YkCg>1`d){n^}Yup9-VztFj*DKv}*`RBs zS^0=f++6$x$Nu-RIf*pF%0~svMNRO$8F^y_82S1*o)$EqL7C%SiS8}S`;qDQ$@!>Q zyL1gxL4pyjg6XtVLo#`xgR3sIYmbbkNm*vU0s7hjleXdh37N_2uh)0B9i#?#zO901 z+d3Z{TS6)>2}6UPBPMuCqq73idLg;af#kMdApYB(GFj6$k?8J-BA-h>!z1u!+$y+Iw}Mhu)!In;)Z>id2^0@6JYMI%grSWuOXwE9aN>Rdbi z&{{*ofyosnXzei{e~qRay)oA}GNFA=d8uZhG-&Q`FgJ^@It+^P*fSf>Y(BG+&Q$^7 z6G49RxoG5rOLEagDI2_1!jwQt!<7*mIMd9!GW%Z|JwlZ1*2VVL0}A4fR!KLhHu5G< zEg4BS1?`!>HsYcrNx&)MP1bEov4S9*x~1W?8X}SI(Xg4CwJyW~>4G$98!{+2WAgbE zG@nI49CEu7Q+fJ2y&Q3MNrFc_kCK+N;I%H7g&p;KJ>|$i83rIg6pc+^`o2>JY3l1j zv8O-Gco2_K5M3$mwL+=5`z*|E@V;d#7@^i<$@x*cZ~iPuqccxb4&Ct-i7HR1G#%Hm zc@fhR#wu=tj`hm^O1acm-`Nqt_Vca+f;~P2jK_Xq$1Xx9Ip>m zwF(S})&a)$y%@f`MquD0KNhDRoqt^9Qn0t}F?@X?Df>a(J@MLGYD=FZr_$@_V$^(epvYlt|i^xr7P37#1*sbDz8 zwwMLcK&I$NE11Mor1*YV5XM+}`_^WD*@+IOre^_7L9gbrj>EX6zOmimBp-s&qNa69R`dUxv0bi$>q5%MCs`h@W-Yck;>~F?d5T z4Ynu#vxu9FY%m4;W`<<9kNGq#AAFgsC2&3O{eZ^?I1+?M-h^(WeNpl+aM zq@M-iSR2mm246JVTFy;HRm7ey&$l9RY!>PZO?tDkh_sa=Zj2LyNaXt53y$Uqu!V%I zgn)H;stI!$NEtK3$U{EaXcznh{>RA5UN{tU8|$-OVgmkLx{>6^C>PoD;u<5YuR*Ox zcMejbIE>ZT62?7TJNe4u>st$i-p8N)Qg?qAaxmkOl7zEb^Mf9b`MZU1rn4>?wq}(h zMWb!b$gbR;WNJ)Pvho%!ltH?kEsh^B3zl0wr7S3Z89$>5D7hk)%73o~e9RBM;sLFSF9UXS z!=$UUCe50Nv+_ko@9-yvo3CC90%wqH4uV%fc#5lC2oqVvzxL<*;w%%*=a#eO7?PwHssh=@ql@ zl1=oCzOsJb|7n}mGHX*(28F1~^+lC$`voAZKT5Xc(XpsKKb=1w&|69bj>hm0wd3OPY}Hdm>j_$eOFsAm2w?mhv}3^yzL2M!^^898Y*7a^$rGJPb{` zT*7&+?w_W*3m8=j0XBl@!cq`hrWueM14=lNfJ!0tV9|ckEsH5l3pL_7TQfSU#w{Fu z$c3}vXT?M&hbc5=!j~UmVtF4r^7wef3W1$dcy%0>gA$PH*$)fs0D4B(Fo7LFF>*w) zq64*;RLx5mWX`9qFAT$?p1*(XZeZFeebrGWH6(&C$j1rZtI{Kcmy3bv?)(mZX#bEF zVeiLhE&UUGW6Lu00l{t>kYKpv!19lFzi8-WV8AY?CUr*g9VKh2$dsb2#)>0qg&iBM z%#P85K?smzn(oY$u3b{Z+1bv@?}B%>BJD?>UW#xMRYo|ZR!s&5VZU}El5}5N0^w&uDV&oQ+ATYm^#^gsaApM~jKb*;`zzN+hr3@~ShD%DU&=v_^y`#8D*$YR zBs(!`cUYC9T&ELukG9DbJlRgKCk*{pHwIT&Qn*i%n3@E6X=?eghV zD8lYaAb(r~3=&7fX6k(1>k^ERfcKHIYts|JA|cVU&)Gd(+tqr%!XY4F=M&#YFE#!1 ztD2E)R9EWg;-^7vP$@<(78xKXXwd;f_cpu)*#kdyX*X*A%bD+04tx95jU;it8$C>4 z?>`cNWaP)odx3Ai4D=|Mj*D!jgxKR_UwzUU`(JKCPF3=7v>v&OMZ-}PT*^b*Je7a$ zs`xd#&t{FojzJ}S$8$4T>DY47$Sx|`FgHq2+#*|}GiaxX^<>Q`&!U*VVu%Jy-m?I` z7r-IeNv!dAAxa$tRmh=#~{p`a-Oo9ys)+hresOHiE;E6)yYY5N6? z1N%GT#&W&`V#7rL8~(K;Mc$#l&6yR}MWckp?d`*#gY0OFRwt{eIvvDCc{h9@l>=ab z?=L{1o4HRE)%HMg7PlL2Xy(GnrvUS~2T%z917pB#Y@RXS2FjtM4zQ2feO!FIU$qz? z6@OCl)K=iyL2;!0l6SY5@4bHwgSD#R!JuLh`71Uc;N|6cuL748ap#2wTV=4*seAb4 zGo6v;0-LNgd+8!=PGLrsp0U7?&F#-|uL56D8f;?1_;u z3F%l_OLkgMSly>`Z+IfM20g=8$lWKixNVGZY)IJjP@p&~Gw>hO+8I+4EUD?orT!mK z$U4MEF@?vxZ^rot;%pI2hvV%GDDrwJtBs9*>bVS|xU;G=gr2Jc>di?0aa%3jFtQ<UCjPae?@;*^1Bak4 zis8^lbm~;ZR`$q=jLqmzfqB48P@dlon-na>JJe4VdUV*+mqEZg;mr@(k0ZDgqrwjr zxYFV;oLA6pDy96yRRr-~O}v#}U%qTaw7ikUPxeQH2*hvvv4{^7C1;;z^b?n;-F;#` zB^6Rd?y($pZ89(=?TWjvTFa%e9JX|B$aXro9Cwb1DH-o%(X@?v6J$Kz`12M zAb+5;hLuQw;~>~iMO&O%IpK#SzdL5R;#3DO-8-gA?;0u4Nli7IWAcB^c`YgmJ6A|j zj-RHWOquZbigH~2<6X%)JU5eW)@=@Gar+&cThUsT=^jRoXCpSWl{}(&hYi=k7ekU9Mw(u8^;0Tx z?IMMWX8!=l@9bG4kUi58Z%y~@-W?U;78|J6y^fzwL5dpCqi%6OkFSg89qfR(LIgTb z!)ifNCG1_eaEfgGnvp-yp(f2NL|KRxPP&72w!ywUnE{edTxfvx0#SY-MzKx2=F`hACT zbksvRq15H3)KH|?X#Eh#t&=z!=k=4`^psYvCj(ODO}Fp$=a1J%lfLIJ&+onITv;!r6j8_UdUJ6KNyEpZ3mKNif&K`l2|?6oDyFiWq?+MQ~q@J!q= zqX}pxU-|GG5KGBOk+fM^7mcx28@WUEFBsE2TFO|-2Y$~dt__1oN*i`i1!n>;yz!`u z?8Lrx@z(kLvKd09p3j7%=)4eCDqSeNMO;ZU4I zUa}|+_`MBi$j9rQjHxIzD%1=Mz% zWkJl3G)CzCUz|A*Mp8vF{KPa*H0zDti3JP^>x^p^D~K)DK(=Oe9gv z*Ks;QpTHuToDyVw3SlkBgu{VG4eNFYQHO`{?wv9%lcA?%R|ipw{mJ4ydDxl)A5eY# z1t}A2%sk&DGxz9F_IXNo9OCQ%&v4kA#vU3zkTm}&eO@Y-qU*5m{A5ZhdH4;rDzBp`F7arzBLJPf30*dC5}fK+xZJ2)$4zmuf5 z7>vp~t=x0W46zpImvJXENFcVjYhyQHcD!}LmiSTgko}olA5R`aZ`mrp(>)L$@TS=fH`{P-DbQb%Zpb6dw53m%5!YUB z5nwy3-B}7F7dk{es|5AdwDXKwxlzo|eu8X76J=LoWG(9(8l=(7Xu&M7_zMWa06aMX zN78H$FrJ(d3I^h{$k(h8u@@hx%d|~!_;2~P5F&oh6JVDeXN3QYlAsa(NlC=!3eK8Y z4?y)^s04%cqwUnq!x!CL>7#30OMN%m9@`^!H@JsGCLad1nLe83U3A)pIH%x2tu%~| zJh}LNp!?r_g_Dc$j*-&fj0`|}?r_Nr`;_t>qFv+uM@eCG4fgv*aXW@eeQn-;&ssyw z;6uHs#V!?B0pvh{Jn_Cnt?9Vk=MH$@S88f(KpH{syf*5&$a9y6lY}=Jek>uxF*{-- z8#F5Wt;1qvOR?Gj+g`L;N_Ht`x9C1|8mH|3y%)Zsd&9LRF+s*WL)U7B%qO~yl36(? zO=_Aqt=l?aL3jR4$Yc>a@#zAV-Q|eEhmWdEVY09q{*CHa>xie<0l!jzXlKc1#@t%5 zC&@(n8jw-@Ip$`BjDHmMh+_q++_}+)hk8Ra%-FDIzrr~X^FeW)vSIPP-}7j(b?D3U zD6w6qmd=~}xy^Vskm-H-4(p)tY_$A+MYSw+R}9%zE78~0%QBC0T#HIXV}~5P>&L$u z^WUkx+_)iS^8bN3kR$%Y9Ckm{i$*e!tF30wX=^90ZUV2R6DD?`;h#qs*Vh6wTTLyZQ7!3s;h3)c73?3-?IvM6@>z^BncrAzL4pl;%RV-GU>s= zniMl@Vgo(K4%bXLg8ntMeg{7kw=>}+xR`57NE#_t_niJ_$omm)jMD~E-$F4T)=d?I7Mmd^A*eklzgC@RGT_UN95bV>n2=6}<^qVVf$V`W{r1G)DCD z-4gZ9cas@V%02MHchnlP4!dS?G0F*OX$E?J>J5ssDlfyCu& zj{!p-YsqEFn$88#McCLk`eh?&Whkj#qaU^*o|WN{@tBLQBxV->=zWKg)W8^ZUV8C6 zBR1=4-C`Dnv&QYV6ls!2+VQ-Yf8x+^xhAK$1qRzm=)+PzB~962wt`+w@gN|k?7%Bo zn*JmRp2qxI`DldDluh*wzfbCq__+AZHK8I1nO&}D1YYB;NU4v!K&@`L|Iq_UGvP@S z!94&!HLS-kS+7xI4_`qy%7XOtXBW>fW}!TE$jjoKHlM`5wuIDD5U2nr3i(e6@!vd~llI(DdF}cFW$-oB{Iv>!*G% zBpn+2-?jDl%rO0~e{l^z7m(fp&aGwy&OZ$+` zZ*xYUR9nxJ51|=RUAY>THnZ2p%j2&!^b=2!Qb(pPkB)1edovFgQEEwg67$77)<<;l z1}*ri#vjyN>T^%4n8Qaa&^Vf-@w=x+>TgtWsO54 zD%2@tW{-;_xvTc$^#AbLZ5H?gHG{mM6hyEE#ut<2r zqNrIAiyFGTV-?`68*7}$Z;)A!7ySbN+uZTn{@|G$##5IU%a5LiDpc2Bp2vAt!vm;H zBOdryk44ev3_No3k`){wPO%{2l(hLU>g{FpPBbN4)>Baa8s2#@NM)+4kBKHkFv*=+ zshv3-9dAz$?*zg%!pjAGW&I8wI86U5cp&?3bl_!26)K4q6otk(8R=*f1u}WOMMFGWp4y3!~X{dvIcw=6p4yYIo>fo6qRla0JK7 z;mD1zzD`1Gy8ooBA=V9g7KE=fGmA*ADd0YpTIG~wp+Z`H&Gajd@VIPPTQ{{E#7@D% z;-pAq8YpBj{n%X>fgWF^?;-dv>hbzYX|d>9wagRcM^u?qUXHpQ`qyDEOE_9U+<*zc z6EAw727di@7;|r(K_asgcQXc4M2yLPO9!V-){$~8Fvu%vwwMcN+lpEPfAq>x;9MM_ zK`TRay~|ldt~c#Pyz0=0f~N=%(}VvE1A3}R`4#%2lZ?v;jy{NCad7G4USYUW5{E81aTlR!zspQti7FX<`KJ9S<8jRUn~QY( z%|+S)E+V5oEyeq#Uvq;)prQ7K)ZHs>^5@I#VnTrDk;bV_>t=epxvR*f4N3?l>vs_0 zj&=Qvr4|Z9+@o4lS@NceF2|F@@ze+%eTO6e4*|Md zz+ZsmO?T1NAbvxcTA#%fN}$4#NTS-Ptywg}c}H#cx+jR?>8i<*ZJFrjyH)0-$*wH*meoh!uadk($UvWbe|{^8 zyMATH`pY{fDMc#Mu6%b2F}qrCrs*7iYVj+dK&&(kEu+tP;v}~ft%^Uu&aAoxZsL45 z5LY>IT?uiF*4}DuAWv`CEuJQYENUt_kH&J)lKk{rjJZH|tINHFKi`=dsQfi`;i>942z98WluL@M~XN0#p zho;xPf5H>NU+_ds+YPJbP|D4G4^#QM)8U;tuKIJw4Vld~oH2-)+q4}`TqjfT)o?_c z?gYW7v+aXlR0=y=@#VWC2KarQ;G%gwm@fYz$pSKv!&uuJuzo5`{)+*BH5l~u;e-?N z0uicg;CJ>Dt}^WxXH##%GLsSi8=qtidi@)pFk#)S<<)l~Ni^Vt`ACZp29!FK*mz8b zU)%LYU!0q5MKqSls|9B`q@oD^BQT2x~5>t!IxK zpG)~!&DEcKjbgC$@4be1B!wOB!l}Au%MF_1W)PB1*^d&jD^r9Yhh{lBEl3h5yQ3#* zfSB@XZ)~i%u^xH7eEifLzTsmTe(wu`G1Lus4)%#EtFRd7u_MKGpP^?auJ#jsks#yz zr$ZzOop3O6b5ixxyOTMFFV^pZQr_dWL=9l@?)mtmL`XDd3)<{;{JW!I!!f$BpOX&% z(cY@3`dt3Dp-ZG)Yx28_=$#!o@5QFf>4{DFv=N&;;?qBrka_qZ?mfB{_fIvQaP60v zqo#-AT~e40RZw!?FBO~D)!Pka-2a4Y#K zXs8@v^;pU67oF<#tTJe#EFuT^gNK$Xv$XD!x0Zoif*hv2W)#O(Gy}iY#F3B#Xa%qG z=%Xf+IBWt*GY2doKFCbvRm~~rcNhT(U-m42{N!!{Qf_$Fk5~U`=NoA0=9C4T$S@G8 zHH<6QW)_%HxOU?QW~7p`bfnb7X%s$!v$$vR+Rpd_It+0r%kW)s_uDB97ixrk>%0TH zFJ@930h04swV(PxcG-*pl5C*~_@65?C;aa%?bX0ee3^?EBfA+w7TD@l z6d`~TBJEhb83|}*!|B5JKWVx(LPYb$)Sz|FwgR$;qJ^-GnqY3;SLZQ*4*Nb17=yo* z5SC+n6J#o^v4>srt#O;GZkqu7mYLvHU-+%YEpg~Z4_SWnhY{APp)>+`)0BzaC1sf% z836-KrrLH=%qmx@p&K?)I~Uh8(dv#TEqy0#RO<~$lL)iljyhtL&F_~VH4zIdQ30k| zf1zKM&nmNsRU^=Muf&uC@eWFX;h&yX9SsH@#zk^c-`ckET#Eg2!fvX$LX~Fq5avY} zYTx;yHvs~bkTYpwoCqYPf4B+%=jA{(n?lf8VO-Cuou+%eaCIY;+7HhxofLqxKNkE) zqK^c)Lb|NC^u0MnZNV5oEHYB9Z`jN2c=NAI%YX>_C_d# zAK`7SI-5ik>g7kqS3)&P^@Z3!JzBxtFAwG>_k&MdDcTNDYv}O52z<$V(=ESc&ZO-p z^sdSpi*k-!@m`Dpe_<%=!gpJBkNL0I_(gDCiXr!O$jbMV&GIjLIXlcJb}V&{f`JV? znY3$#sE0TZU~L0W;Bqsvdes^(xY7a}h7${<8r-y&eP;tBLr>yrxP1sEEi*u2tQ)6h z!2MaQlU*IT@B$XbZqK|Yqg3$ds>t$I>HF1z1S3I1y=^9%Tr9pr$KZ?A3P#Y>?V-or z!yS1?`dfS|VXw;hqv)1pgE*9~8#Z^hFZ+y`2e=~F6bSI@eddu!l+!#J!Ck=rp2*mH zD)Qgwus$A=M_*g%uYoYRlT%4>$IX~4*)s!mgtuQ8(hg0b03AIufn0UAut8J0dl+<+ zYG~RTdZ)D@uvf_ink?smOg1ckttvDQ?RNiIs;b#qFVQpz5o96DDES%u{&YazNWA7H z>;fAE`9z3n;kZ5BN_hq&E#RW1Ir1^Rpb$hvFIs_$W;Q_BHExUMH1U4p%aYt{H zT7|V%lQIUliuOH`Gv{f0jUZDDrd*)O3eF zm&vQ`W>!H?+g^dcnv)pY?HA(h-oM$7{w=_E6w-~9gi{)cz~dHF`;45Ak_IpT)Xf)o z;qnOl6nPC1Iib%?AzN7TpBm-Qs$bNqrh2gwmC*l$`@!;sShicfFSs;i%e@{SPbo>R zKw9bnn7{-p*NQXKkD(|Fyx{XI6XcQTBhl5s8d2A>jH34qgvLXy}rwB4p{R z%SSy2q7i});9cQ%Q^^bK7~VpA*WW?PuM7o>h2@rkt_FDh(yu65+vfEgD6CAy=~l50 z^6E;=N3h8h(hJe@1$j}-IDu#=i2(*M0cn`V| z|8s!TyJr5Fq%8e+lF~5u$QI~)H2VW`Nj;q0BW=Orz_iC8(&L&Dv$1G?-9%>;%LpPx z0mPQPvJYeT!g#XY<+x2mXxwLn!Q_9jCa{y~j6E6K%;HDTGBG|XLC!A_v&N-jp0Fai z-5ETVIA&bKPJyHof6~57aAXjEZ`#Jip1gqQfTU`5im92}qL0bD~SMjQ{6vtWPU ztU$i(qbM+vu3_m}R)c-?H>D{{8Gzh3y2BRopSaRS&7*4j*C&n1WU<`R<$te? za>-m-Ym&D|?!?TZ>2Xebr7DD_KQQ{l%P}bPv|ru32coQLnF~4SMW- zAO{jjMt^Q@B<7=E`=O6H+jMZVDhU30d4j6jpg1y0{&>{b%bRw$*o+F3l;9wG#zeQf zGKYfyp4^ZoKG@jZ|2?^x=;uJ7^S0X;xdJ3AiC|2Iqw?BaR4ZTY?#f-kZbwo6^4Y}u-d5M+CJCSAc99d<=ca-L0qPh~HzW4z8&SYEa zH0!CC=Yhs`#6)+v#YX#xBze5>L3m!S7QQ7={oID8UMzol%c=SB-n2{%S*E}oOZDWa z%-EHsKib8q9Ijzk*}&!W8r>L!=YQS>k@n$1{jZ>g z)+YH$#v^93QGiQICDMN$Zyx#^#{5K#c7A}SyDk_0h8*;9AXhi^M1kO&N16KIscKhp z+3ldVy7@t%%08aRmAmIW?HWA?jFM`H|eK37i$+ZsF_TR&0& zi}%o-v8@F&d9j~&rwVNP9i*LJPjf;#)Db5>bJO6hBty zGR~}-gxpEyJ1BHqd9H3hM(Qf-dVT&~q7Q;DCGk_HwVvA0`C5IeAw~MvoAQr5XBCKS zXsD2{Duo@ij`oI}6>e+(7Eq8Pi*9w3WAgF_ zBW7zOrr@qH_ze~+V$_Frvh9VfgF6a{Zt_VKI zOm9zhPw~*5h=7sggv{&ZH?DqcmahY|%GF}NUhP-a7)-f&tfcVV0yAlh=7H`Z65Snx z&3<@MaOcXA?6)2Iu|E#Xtu*}t;M@;wQ?Am>N3!zXA$55t2$X(u+o%0X{Zx9NSK4=_ z!M`Pbt%>9y-49f&{^pY8Ig7jR)+1xd?S>nvTd>BxPq({TrMN62O1cn-*G9WMkhgM* zj4}$;D=ZHRDWCM9Wd#rCXX72qNx3nm^E-U@web2xA#(Moqd35V%Zw8{$6|jfW0bj{ zS@KOKjfJ}YMU>XIp}iV2ds~)1#LbXCKNycyj~;A}iDCH9OCtW~^aix>nxgerymIG1 z);Cg|-T^ArP>9bi^S{DdJL6rhl6TJfDi+wAN4DI2bQQ(3|&U;_jKa z^;h#0a2?*rqx(3MJ<2PEBl@_IJ31;|w0-}7L@Z5+{%6Fp{GSm^m5E3`AgN)EN1J#( z-JE{g3E-7i4QtTaPg_37IX4Nx)IMfx9yvhE3L1{T$nS~paW12W5%`CSJl0+>`2>M z^0S}#^qs5ZpOvEoDCgNFGF11L7M{?P)UTX~m5BDFh-qLy)YfJt%o_4;gx-IWsI!&H zR~VSAPG@QP7FgrqykkS;ok^tiqOeeb-3Cv2z(U`HSP|;we}yS)^KMS#?mxwRV32dz zzy@;eYRzq~{i%n4_)$L$?I`5t2)B-dlzjF(2 z#f4~S6oHlSMo0DdcZ(yBej%M(H&F79kU`1Z-RNH$E{>Wu<0=%NReke+pXU|-}#Ae-Gnii z$hOV7GRoejF$9z)B%d>gUMcbeXasIvFtdzdIIV}3;{1tPt{Yb6X@UMY@B=4DId)YKZE1ut2 zjf!O;!&29D=z7h0KBE~d?DmEMp0WND_U0@c0zfGi^Fww`4_$&A0V1DK^*Ko`>b7t` z^WaaY!Z`f?e&yYx$pQEnz*Q@*?seE#Fzgxh2}$S)hTPq=q`xB(-w2AIp q!Tw>DFdY2 + group_by(across(-compressive_strength)) |> + summarize(compressive_strength = mean(compressive_strength), + .groups = "drop") + +set.seed(1501) +concrete_split <- initial_split(concrete1, strata = compressive_strength) +concrete_train <- training(concrete_split) +concrete_test <- testing(concrete_split) + +set.seed(1502) +concrete_folds <- + vfold_cv(concrete_train, strata = compressive_strength, repeats = 5) + +normalized_rec <- + recipe(compressive_strength ~ ., data = concrete_train) |> + step_normalize(all_predictors()) + +poly_recipe <- + normalized_rec |> + step_poly(all_predictors()) |> + step_interact(~ all_predictors():all_predictors()) + +linear_reg_spec <- + linear_reg(penalty = tune(), mixture = tune()) |> + set_engine("glmnet") + +nnet_spec <- + mlp(hidden_units = tune(), penalty = tune(), epochs = tune()) |> + set_engine("nnet", MaxNWts = 2600) |> + set_mode("regression") + +mars_spec <- + mars(prod_degree = tune()) |> + set_engine("earth") |> + set_mode("regression") + +svm_r_spec <- + svm_rbf(cost = tune(), rbf_sigma = tune()) |> + set_engine("kernlab") |> + set_mode("regression") + +svm_p_spec <- + svm_poly(cost = tune(), degree = tune()) |> + set_engine("kernlab") |> + set_mode("regression") + +knn_spec <- + nearest_neighbor(neighbors = tune(), dist_power = tune(), weight_func = tune()) |> + set_engine("kknn") |> + set_mode("regression") + +cart_spec <- + decision_tree(cost_complexity = tune(), min_n = tune()) |> + set_engine("rpart") |> + set_mode("regression") + +bag_cart_spec <- + bag_tree() |> + set_engine("rpart", times = 50L) |> + set_mode("regression") + +rf_spec <- + rand_forest(mtry = tune(), min_n = tune(), trees = 1000) |> + set_engine("ranger") |> + set_mode("regression") + +xgb_spec <- + boost_tree(tree_depth = tune(), learn_rate = tune(), loss_reduction = tune(), + min_n = tune(), sample_size = tune(), trees = tune()) |> + set_engine("xgboost") |> + set_mode("regression") + +cubist_spec <- + cubist_rules(committees = tune(), neighbors = tune()) |> + set_engine("Cubist") + +nnet_param <- + nnet_spec |> + extract_parameter_set_dials() |> + update(hidden_units = hidden_units(c(1, 27))) + +normalized <- + workflow_set( + preproc = list(normalized = normalized_rec), + models = list(SVM_radial = svm_r_spec, SVM_poly = svm_p_spec, + KNN = knn_spec, neural_network = nnet_spec) + ) + +normalized1 <- + normalized |> + option_add(param_info = nnet_param, id = "normalized_neural_network") + +model_vars <- + workflow_variables(outcomes = compressive_strength, + predictors = everything()) + +no_pre_proc <- + workflow_set( + preproc = list(simple = model_vars), + models = list(MARS = mars_spec, CART = cart_spec, CART_bagged = bag_cart_spec, + RF = rf_spec, boosting = xgb_spec, Cubist = cubist_spec) + ) + +with_features <- + workflow_set( + preproc = list(full_quad = poly_recipe), + models = list(linear_reg = linear_reg_spec, KNN = knn_spec) + ) + +all_workflows <- + bind_rows(no_pre_proc, normalized1, with_features) |> + mutate(wflow_id = gsub("(simple_)|(normalized_)", "", wflow_id)) + +race_ctrl <- + control_race( + save_pred = TRUE, + parallel_over = "everything", + save_workflow = TRUE + ) + +race_results <- + all_workflows |> + workflow_map( + "tune_race_anova", + seed = 1503, + resamples = concrete_folds, + grid = 25, + control = race_ctrl + ) + +concrete_stack <- + stacks() |> + add_candidates(race_results) + +set.seed(2001) +ens <- blend_predictions(concrete_stack) + +set.seed(2002) +ens1 <- blend_predictions(concrete_stack, penalty = 10^seq(-2, -0.5, length = 20)) + +ens2 <- fit_members(ens1) + +reg_metrics <- metric_set(rmse, rsq) + +ens_test_pred <- + predict(ens, concrete_test) |> + bind_cols(concrete_test) + +``` + +```{r copy-code-chunk, child = system.file("child_documents/copy_button.Rmd", package = "tutorial.helpers")} +``` + +```{r info-section, child = system.file("child_documents/info_section.Rmd", package = "tutorial.helpers")} +``` + +## Introduction +### + +This tutorial covers [Chapter 20: Ensembles of Models](https://www.tmwr.org/ensembles) from [*Tidy Modeling with R*](https://www.tmwr.org/) by Max Kuhn and Julia Silge. In this tutorial, you will learn how to create a stacked ensemble, using the `stacks()` and `add_candidates()` functions from the [**stacks**](https://stacks.tidymodels.org/articles/basics.html) package. Additionally, you will learn how to blend the predictions from the stacked ensemble with the use of the `blend_predictions()` function. Finally, you will take these results and compare it with a test set. + + +## Creating The Training Set for Stacking +### + +A model ensemble, where the predictions of multiple single learners are aggregated to make one prediction, can produce a high-performance final model. The most popular methods for creating ensemble models are bagging, random forest, and boosting. Each of these methods combines the predictions from multiple versions of the same type of model (e.g., classifications trees). However, one of the earliest methods for creating ensembles is *model stacking*. + +### Exercise 1 + +Load the **tidymodels** package using `library()`. + +```{r creating-the-trainin-1, exercise = TRUE} + +``` + +```{r creating-the-trainin-1-hint-1, eval = FALSE} +library(...) +``` + +```{r include = FALSE} +library(tidymodels) +``` + +### + +The first step for building a stacked ensemble relies on the assessment set predictions from a resampling scheme with multiple splits. For each data point in the training set, stacking requires an out-of-sample prediction of some sort. For regression models, this is the predicted outcome. For classification models, the predicted classes or probabilities are available for use, although the latter contains more information than the hard class predictions. For a set of models, a data set is assembled where rows are the training set samples and columns are the out-of-sample predictions from the set of multiple models. + +### Exercise 2 + +Type in `tidymodels_prefer()` to get rid of naming conflicts. + +```{r creating-the-trainin-2, exercise = TRUE} + +``` + +```{r creating-the-trainin-2-hint-1, eval = FALSE} +...() +``` + +```{r include = FALSE} +tidymodels_prefer() +``` + +### + +Model stacking combines the predictions for multiple models of any type. For example, a logistic regression, classification tree, and support vector machine can be included in a stacking ensemble. + +### Exercise 3 + +Next, load the **finetune** and **modeldata** packages using `library()`. + +```{r creating-the-trainin-3, exercise = TRUE} + +``` + +```{r creating-the-trainin-3-hint-1, eval = FALSE} +library(...) +library(...) +``` + +```{r include = FALSE} +library(finetune) +library(modeldata) +``` + +### + +Back in the "Screening Many Models" tutorial, five repeats of 10-fold cross-validation were used to resample the data. This resampling scheme generates five assessment set predictions for each training set sample. Multiple out-of-sample predictions can occur in several other resampling techniques (e.g., bootstrapping). For the purpose of stacking, any replicate predictions for a data point in the training set are averaged so that there is a single prediction per training set sample per candidate member. + +### Exercise 4 + +Next, load the **rules** and **baguette** libraries. + +```{r creating-the-trainin-4, exercise = TRUE} + +``` + + + +```{r creating-the-trainin-4-hint-1, eval = FALSE} +library(...) +library(...) +``` + +```{r include = FALSE} +library(rules) +library(baguette) +``` + +### + +Simple validation sets can also be used with stacking since tidymodels considers this to be a single resample. + +### Exercise 5 + +Load the `concrete` data set by typing `concrete` in the code chunk below. + +```{r creating-the-trainin-5, exercise = TRUE} + +``` + +```{r creating-the-trainin-5-hint-1, eval = FALSE} +concrete +``` + +```{r include = FALSE} +concrete +``` + +### + +If you recall, this was the data set used in the "Screening Many Models" tutorial, which contains data about concrete. + +### Exercise 6 + +Press "Run code". + +```{r creating-the-trainin-6, exercise = TRUE} +concrete1 <- + concrete |> + group_by(across(-compressive_strength)) |> + summarize(compressive_strength = mean(compressive_strength), + .groups = "drop") + +set.seed(1501) +concrete_split <- initial_split(concrete1, strata = compressive_strength) +concrete_train <- training(concrete_split) +concrete_test <- testing(concrete_split) + +set.seed(1502) +concrete_folds <- + vfold_cv(concrete_train, strata = compressive_strength, repeats = 5) + +normalized_rec <- + recipe(compressive_strength ~ ., data = concrete_train) |> + step_normalize(all_predictors()) + +poly_recipe <- + normalized_rec |> + step_poly(all_predictors()) |> + step_interact(~ all_predictors():all_predictors()) + +linear_reg_spec <- + linear_reg(penalty = tune(), mixture = tune()) |> + set_engine("glmnet") + +nnet_spec <- + mlp(hidden_units = tune(), penalty = tune(), epochs = tune()) |> + set_engine("nnet", MaxNWts = 2600) |> + set_mode("regression") + +mars_spec <- + mars(prod_degree = tune()) |> + set_engine("earth") |> + set_mode("regression") + +svm_r_spec <- + svm_rbf(cost = tune(), rbf_sigma = tune()) |> + set_engine("kernlab") |> + set_mode("regression") + +svm_p_spec <- + svm_poly(cost = tune(), degree = tune()) |> + set_engine("kernlab") |> + set_mode("regression") + +knn_spec <- + nearest_neighbor(neighbors = tune(), dist_power = tune(), weight_func = tune()) |> + set_engine("kknn") |> + set_mode("regression") + +cart_spec <- + decision_tree(cost_complexity = tune(), min_n = tune()) |> + set_engine("rpart") |> + set_mode("regression") + +bag_cart_spec <- + bag_tree() |> + set_engine("rpart", times = 50L) |> + set_mode("regression") + +rf_spec <- + rand_forest(mtry = tune(), min_n = tune(), trees = 1000) |> + set_engine("ranger") |> + set_mode("regression") + +xgb_spec <- + boost_tree(tree_depth = tune(), learn_rate = tune(), loss_reduction = tune(), + min_n = tune(), sample_size = tune(), trees = tune()) |> + set_engine("xgboost") |> + set_mode("regression") + +cubist_spec <- + cubist_rules(committees = tune(), neighbors = tune()) |> + set_engine("Cubist") + +nnet_param <- + nnet_spec |> + extract_parameter_set_dials() |> + update(hidden_units = hidden_units(c(1, 27))) + +normalized <- + workflow_set( + preproc = list(normalized = normalized_rec), + models = list(SVM_radial = svm_r_spec, SVM_poly = svm_p_spec, + KNN = knn_spec, neural_network = nnet_spec) + ) + +normalized1 <- + normalized |> + option_add(param_info = nnet_param, id = "normalized_neural_network") + +model_vars <- + workflow_variables(outcomes = compressive_strength, + predictors = everything()) + +no_pre_proc <- + workflow_set( + preproc = list(simple = model_vars), + models = list(MARS = mars_spec, CART = cart_spec, CART_bagged = bag_cart_spec, + RF = rf_spec, boosting = xgb_spec, Cubist = cubist_spec) + ) + +with_features <- + workflow_set( + preproc = list(full_quad = poly_recipe), + models = list(linear_reg = linear_reg_spec, KNN = knn_spec) + ) + +all_workflows <- + bind_rows(no_pre_proc, normalized1, with_features) |> + mutate(wflow_id = gsub("(simple_)|(normalized_)", "", wflow_id)) + +race_ctrl <- + control_race( + save_pred = TRUE, + parallel_over = "everything", + save_workflow = TRUE + ) + +race_results <- + all_workflows |> + workflow_map( + "tune_race_anova", + seed = 1503, + resamples = concrete_folds, + grid = 25, + control = race_ctrl + ) +``` + +### + +These were the variables you created in the "Screening Many Models" tutorial which eventually led to the creation of `race_results`. + +### Exercise 7 + +Type in `race_results` and press "Run code". + +```{r creating-the-trainin-7, exercise = TRUE} + +``` + +```{r creating-the-trainin-7-hint-1, eval = FALSE} +race_results +``` + +```{r include = FALSE} +race_results +``` + +### + +The process of building a stacked ensemble is: + +- Assemble the training set of hold-out predictions (produced via resampling). +- Create a model to blend these predictions. +- For each member of the ensemble, fit the model on the original training set. + +### Exercise 8 + +To create a stack, the `stacks()` function will be used. Type `?stacks()` in the Console and look at the *Description* section. CP/CR. + +```{r creating-the-trainin-8} +question_text(NULL, + answer(NULL, correct = TRUE), + allow_retry = TRUE, + try_again_button = "Edit Answer", + incorrect = NULL, + rows = 3) +``` + +### + +For the concrete example, the training set used for model stacking has columns for all of the candidate tuning parameter results. The table below presents the first six rows and selected columns: + +```{r} +knitr::include_graphics("images/pic1.png") +``` + +There is a single column for the bagged tree model since it has no tuning parameters. Also, recall that MARS was tuned over a single parameter (the product degree) with two possible configurations, so this model is represented by two columns. Most of the other models have 25 corresponding columns, as shown for Cubist in this example. + +### Exercise 9 + +The `add_candidates()` will be needed. Type `?add_candidates()` in the Console and look at the *Description* section. CP/CR. + +```{r creating-the-trainin-9} +question_text(NULL, + answer(NULL, correct = TRUE), + allow_retry = TRUE, + try_again_button = "Edit Answer", + incorrect = NULL, + rows = 3) +``` + +### + +The term *candidate members* will be used to describe the possible model configurations (of all model types) that might be included in the stacking ensemble. + +### Exercise 10 + +Now, let's start creating a stack. In the code chunk below, type in `stacks()` and pipe it to `add_candidates()`. Inside of `add_candidates()`, pass in `race_results`. + +```{r creating-the-trainin-10, exercise = TRUE} + +``` + +```{r creating-the-trainin-10-hint-1, eval = FALSE} +stacks() |> + add_candidates(...) +``` + +```{r include = FALSE} +stacks() |> + add_candidates(race_results) +``` + +### + +The code outputs each of the 12 model definitions in the stack and specifies how many candidate members it has. In total, there are 21 candidate members, with the `full_quad_linear_reg` model having the most individual candidate members (5). + +### Exercise 11 + +Copy the previous code and assign it to a new variable named `concrete_stack`. + +```{r creating-the-trainin-11, exercise = TRUE} + +``` + + + +```{r creating-the-trainin-11-hint-1, eval = FALSE} +... <- + stacks() |> + add_candidates(race_results) +``` + +```{r include = FALSE} +concrete_stack <- + stacks() |> + add_candidates(race_results) +``` + +### + +Recall that racing methods are more efficient since they might not evaluate all configurations on all resamples. Stacking requires that all candidate members have the complete set of resamples. `add_candidates()` includes only the model configurations that have complete results. + +## Blend the Predictions +### + +The training set predictions and the corresponding observed outcome data are used to create a *meta-learning model* where the assessment set predictions are the predictors of the observed outcome data. Meta-learning can be accomplished using any model. The most commonly used model is a regularized generalized linear model, which encompasses linear, logistic, and multinomial models. + +### Exercise 1 + +Type `set.seed()` and pass in `2001`. + +```{r blend-the-prediction-1, exercise = TRUE} + +``` + +```{r blend-the-prediction-1-hint-1, eval = FALSE} +set.seed(...) +``` + +```{r include = FALSE} +set.seed(2001) +``` + +### + +Specifically, regularization via the lasso penalty [Tibshirani (1996)](https://www.tmwr.org/ensembles#ref-lasso), which uses shrinkage to pull points toward a central value, has several advantages: + +- Using the lasso penalty can remove candidates (and sometimes whole model types) from the ensemble. +- The correlation between ensemble candidates tends to be very high, and regularization helps alleviate this issue. + +### Exercise 2 + +The `blend_predictions()` function will be needed in order to blend the predictions of `concrete_stack`. Type `?blend_predictions()` in the Console and look at the *Description* section. CP/CR. + +```{r blend-the-prediction-2} +question_text(NULL, + answer(NULL, correct = TRUE), + allow_retry = TRUE, + try_again_button = "Edit Answer", + incorrect = NULL, + rows = 3) +``` + +### + +[Breiman (1996b)](https://www.tmwr.org/ensembles#ref-breiman1996stacked) also suggested that, when a linear model is used to blend the predictions, it might be helpful to constrain the blending coefficients to be non-negative. The [*Tidy Modeling with R*](https://www.tmwr.org/index.html) textbook has generally found this to be good advice and it is the default for the stacks package (but it can be changed via an optional argument). + +### Exercise 3 + +Since the desired outcome is numeric, linear regression is used for the metamodel. In the code chunk below, type in `blend_predictions()` and pass in `concrete_stack`. + +```{r blend-the-prediction-3, exercise = TRUE} + +``` + +```{r blend-the-prediction-3-hint-1, eval = FALSE} +blend_predictions(...) +``` + +```{r include = FALSE} +blend_predictions(concrete_stack) +``` + +### + +This evaluates the meta-learning model over a predefined grid of lasso penalty values and uses an internal resampling method to determine the best value. + +### Exercise 4 + +Copy the previous code and assign it to a new variable named `ens`. + +```{r blend-the-prediction-4, exercise = TRUE} + +``` + + + +```{r blend-the-prediction-4-hint-1, eval = FALSE} +... <- blend_predictions(concrete_stack) +``` + +```{r include = FALSE} +ens <- blend_predictions(concrete_stack) +``` + +### + +Why use the racing results instead of the full set of candidate models contained in `grid_results`? Either can be used. The [*Tidy Modeling with R*](https://www.tmwr.org/index.html) textbook found better performance for these data using the racing results. This might be due to the racing method pre-selecting the best model(s) from the larger grid. + +### Exercise 5 + +Now, let's understand if the default penalization method was sufficient. In the code chunk below, type in `autoplot()` and pass in `ens`. + +```{r blend-the-prediction-5, exercise = TRUE} + +``` + +```{r blend-the-prediction-5-hint-1, eval = FALSE} +autoplot(...) +``` + +```{r include = FALSE} +autoplot(ens) +``` + +### + +The top panel of the graph shows the average number of candidate ensemble members retained by the meta-learning model. Also, you can see that the number of members is fairly constant and, as it increases, the RMSE also increases. + +### Exercise 6 + +The default range may not have served us well here. To evaluate the meta-learning model with larger penalties, let’s pass an additional option. In the code chunk below, type in `set.seed(2002)`. Then, on a new line, create a new variable named `ens1` and assign it to `blend_predictions()`. Inside this function, type in `concrete_stack` as the first argument and set `penalty` to `10^seq(-2, -0.5, length = 20)` as the second argument. + +```{r blend-the-prediction-6, exercise = TRUE} + +``` + + + +```{r blend-the-prediction-6-hint-1, eval = FALSE} +set.seed(...) +... <- blend_predictions(..., penalty = 10^seq(-2, -0.5, length = 20)) +``` + +```{r include = FALSE} +set.seed(2002) +ens1 <- blend_predictions(concrete_stack, penalty = 10^seq(-2, -0.5, length = 20)) +``` + +### + +`seq()` is a function that generates regular sequences. + +### Exercise 7 + +Now, lets graph this new variable. In the code chunk below, type in `autoplot()` and pass in `ens1`. + +```{r blend-the-prediction-7, exercise = TRUE} + +``` + + + +```{r blend-the-prediction-7-hint-1, eval = FALSE} +autoplot(...) +``` + +```{r include = FALSE} +autoplot(ens1) +``` + +### + +As you can see, there is a range where the ensemble model becomes worse than with the first blend (but not by much). The $R^2$ values increase with more members and larger penalties. + +When blending predictions using a regression model, it is common to constrain the blending parameters to be nonnegative. For these data, this constraint has the effect of eliminating many of the potential ensemble members; even at fairly low penalties, the ensemble is limited to a fraction of the original eighteen. + +### Exercise 8 + +Type in `ens1` and press "Run code". + +```{r blend-the-prediction-8, exercise = TRUE} + +``` + +```{r blend-the-prediction-8-hint-1, eval = FALSE} +ens1 +``` + +```{r include = FALSE} +ens1 +``` + +### + +As you can see from the output, the penalty value associated with the smallest RMSE was 0.051. Also, the output shows that it retained 7 candidate members out of the 21, as they had the highest weight out of all the members. + +### Exercise 9 + +The regularized linear regression meta-learning model contained seven blending coefficients across four types of models. Let's create a graph to display the contributions. In the code chunk below, type in `autoplot()`, passing in `ens1` and `"weights"`. Then, add `geom_text()` using the `+` operator (Note: This will throw an error). + +```{r blend-the-prediction-9, exercise = TRUE} + +``` + +```{r blend-the-prediction-9-hint-1, eval = FALSE} +autoplot(ens, "...") + + ...() +``` + +```{r include = FALSE} +#autoplot(ens, "weights") + +# geom_text() +``` + +### + +This code throws an error because `geom_text()` requires a `label` argument, which hasn't been passed in yet. + +### Exercise 10 + +Copy the previous code. Inside `geom_text()`, using the `aes()` function, set `x` to `weight + 0.01` and `label` to `model`. Then, outside of `aes()`, but within `geom_text()`, set `hjust` to `0`. + +```{r blend-the-prediction-10, exercise = TRUE} + +``` + + + +```{r blend-the-prediction-10-hint-1, eval = FALSE} +autoplot(ens, "weights") + + geom_text(aes(x = ... + 0.01, label = ...), hjust = ...) +``` + +```{r include = FALSE} +autoplot(ens, "weights") + + geom_text(aes(x = weight + 0.01, label = model), hjust = 0) +``` + +### + +`geom_text()` is a function that is used to display text on the graph. This can be very useful when labeling/highlighting certain information. + +### Exercise 11 + +Copy the previous code and add `theme()` using the `+` operator. Inside this function, set `legend.position` to `"none"`. + +```{r blend-the-prediction-11, exercise = TRUE} + +``` + + + +```{r blend-the-prediction-11-hint-1, eval = FALSE} +autoplot(ens, "weights") + + geom_text(aes(x = weight + 0.01, label = model), hjust = 0) + + theme(legend.position = "...") +``` + +```{r include = FALSE} +autoplot(ens, "weights") + + geom_text(aes(x = weight + 0.01, label = model), hjust = 0) + + theme(legend.position = "none") +``` + +### + +`lims()` is a function that allows you to set the x and y axis limits. + +### Exercise 12 + +Copy the previous code and add `lims()` using the `+` operator. Inside this function, set `x` to a vector containing `-0.01` as the first argument and `0.8` as the second argument. + +```{r blend-the-prediction-12, exercise = TRUE} + +``` + + + +```{r blend-the-prediction-12-hint-1, eval = FALSE} +autoplot(ens, "weights") + + geom_text(aes(x = weight + 0.01, label = model), hjust = 0) + + theme(legend.position = "none") + + lims(.__C__.environment = c(-0.01, ...)) +``` + +```{r include = FALSE} +autoplot(ens, "weights") + + geom_text(aes(x = weight + 0.01, label = model), hjust = 0) + + theme(legend.position = "none") + + lims(x = c(-0.01, 0.8)) +``` + +### + +The boosted tree and neural network models have the largest contributions to the ensemble. For this ensemble, the outcome is predicted with the equation: + +```{r} +knitr::include_graphics("images/pic2.png") +``` + +where the predictors in the equation are the predicted compressive strength values from those models. + +### + +Congrats! You have learned how to blend predictions and visualize them with the `autoplot()` function. + +## Test Set Results +### + +Since the blending process used resampling, it can be estimated that the ensemble with seven members had an estimated RMSE of 4.12. Recall from the "Screening Many Models" tutorial that the best boosted tree had a test set RMSE of 3.41. How will the ensemble model compare on the test set? + +### Exercise 1 + +First, let's fit all of the member models together. In the code chunk below, type in `fit_members()` and pass in `ens1`. + +```{r test-set-results-1, exercise = TRUE} + +``` + +```{r test-set-results-1-hint-1, eval = FALSE} +fit_members(...) +``` + +```{r include = FALSE} +fit_members(ens1) +``` + +### + +`fit_members()` is a function that trains and returns models that are passed in. + +### Exercise 2 + +Copy the previous code and assign it to a new variable named `ens2`. + +```{r test-set-results-2, exercise = TRUE} + +``` + + + +```{r test-set-results-2-hint-1, eval = FALSE} +... <- fit_members(ens1) +``` + +```{r include = FALSE} +ens2 <- fit_members(ens1) +``` + +### + +The seven models that were fitted are: + +- boosting: number of trees = 1957, minimal node size = 8, tree depth = 7, learning rate = 0.0756, minimum loss reduction = 1.45e-07, and proportion of observations sampled = 0.679 + +- Cubist: number of committees = 98 and number of nearest neighbors = 2 + +- linear regression (quadratic features): amount of regularization = 6.28e-09 and proportion of lasso penalty = 0.636 (config 1) + +- linear regression (quadratic features): amount of regularization = 2e-09 and proportion of lasso penalty = 0.668 (config 2) + +- neural network: number of hidden units = 14, amount of regularization = 0.0345, and number of epochs = 979 (config 1) + +- neural network: number of hidden units = 22, amount of regularization = 2.08e-10, and number of epochs = 92 (config 2) + +- neural network: number of hidden units = 26, amount of regularization = 0.0149, and number of epochs = 203 (config 3) + +### Exercise 3 + +Now, let's see how the ensemble model compares to the test set. In the code chunk below, type in `metric_set()` and pass in `rmse` and `rsq`. Then, assign this code to a new variable named `reg_metrics`. + +```{r test-set-results-3, exercise = TRUE} + +``` + +```{r test-set-results-3-hint-1, eval = FALSE} +... <- metric_set(..., rsq) +``` + +```{r include = FALSE} +reg_metrics <- metric_set(rmse, rsq) +``` + +### + +By running `reg_metrics` on a new line, you can see that it produces a tibble, which contains the `rmse` and `rsq` metrics. + +### Exercise 4 + +In the code chunk below, type in `predict()`, passing in `ens2` and `concrete_test`. Then, pipe this code to `bind_cols()`, passing in `concrete_test`. Finally, assign this code to a new variable named `ens_test_pred`. + +```{r test-set-results-4, exercise = TRUE} + +``` + +```{r test-set-results-4-hint-1, eval = FALSE} +... <- + predict(ens, ...) |> + ..getNamespace(concrete_test) +``` + +```{r include = FALSE} +ens_test_pred <- + predict(ens, concrete_test) |> + bind_cols(concrete_test) +``` + +### + +This code creates an ensemble test prediction. + +### Exercise 5 + +In the code chunk below, type in `ens_test_pred` and pipe it to `reg_metrics()`. Inside this function, type in `compressive_strength` as the first argument and `.pred` as the second argument. + +```{r test-set-results-5, exercise = TRUE} + +``` + +```{r test-set-results-5-hint-1, eval = FALSE} +ens_test_pred |> + reg_metrics(compressive_strength, .pred) +``` + +```{r include = FALSE} +ens_test_pred |> + reg_metrics(compressive_strength, .pred) +``` + +### + +As you can see, this is moderately better than the best single model. It is fairly common for stacking to produce incremental benefits when compared to the best single model. + +### + +Congrats! You have learned how to test the results with the testing data. + +## Summary +### + +In this tutorial, you have learned: + +- How to create a stacked ensemble with the `stacks()` and `add_candidates()` function +- How to blend the predictions with `blend_predictions()` and display them using `autoplot()` +- How to test the set results with `reg_metrics()`, `predict()`, and `metric_set()` + +```{r download-answers, child = system.file("child_documents/download_answers.Rmd", package = "tutorial.helpers")} +``` From 215ee50dc8335abf3fec6ff15cbb10ce6fa55ebd Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Fri, 11 Aug 2023 17:47:32 -0500 Subject: [PATCH 09/12] - Finished adding knowledge drops --- .../12-model-tuning-and-the-dangers-of-overfitting/tutorial.Rmd | 2 +- inst/tutorials/16-dimensionality-reduction/tutorial.Rmd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/inst/tutorials/12-model-tuning-and-the-dangers-of-overfitting/tutorial.Rmd b/inst/tutorials/12-model-tuning-and-the-dangers-of-overfitting/tutorial.Rmd index fd9358c..2726ff6 100644 --- a/inst/tutorials/12-model-tuning-and-the-dangers-of-overfitting/tutorial.Rmd +++ b/inst/tutorials/12-model-tuning-and-the-dangers-of-overfitting/tutorial.Rmd @@ -1120,7 +1120,7 @@ bind_rows( ### - +The **dplyr** package also contains a `bind_cols()` function, which does the same thing as `bind_rows()` but for columns. ### Exercise 36 diff --git a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd index cf65e23..01c79a9 100644 --- a/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd +++ b/inst/tutorials/16-dimensionality-reduction/tutorial.Rmd @@ -3253,7 +3253,7 @@ rda_res <- ### - +High-dimensional datasets consume more memory, which can be a concern when working with large datasets. Reducing dimensionality can help manage memory usage. ### Exercise 41 From 77220632c5cf05fa455bcfa2fc9e389a75c10b68 Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Fri, 11 Aug 2023 17:56:21 -0500 Subject: [PATCH 10/12] finished all tutorials --- TODO.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/TODO.txt b/TODO.txt index 5773841..7689331 100644 --- a/TODO.txt +++ b/TODO.txt @@ -9,7 +9,7 @@ Week 3: 17, 19, 21 # Aryan -Week 3: Chapters 16 (currently working on), 18, 20 +Week 3: Chapters 16 (Done), 18 (Done), 20 (Done) By July 28, done through chapter 9 From cd3ba277b4699adfaaa51a1ff91cb24290bf7dae Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Fri, 11 Aug 2023 18:18:50 -0500 Subject: [PATCH 11/12] almost done with entire textbook --- TODO.txt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/TODO.txt b/TODO.txt index 7689331..c9e6fd3 100644 --- a/TODO.txt +++ b/TODO.txt @@ -3,9 +3,9 @@ Read Modelling Basics chapters. # Pratham -Week 2: 13, 15 +Week 2: 13 (Done), 15 (Done) -Week 3: 17, 19, 21 +Week 3: 17 (Done), 19 (Done), 21 (Currently working on) # Aryan From 82f8922cf7d6e3797ee63617deb15c34ea4393f3 Mon Sep 17 00:00:00 2001 From: aryan-kancherla Date: Sat, 12 Aug 2023 01:43:57 -0500 Subject: [PATCH 12/12] - added names to description file --- DESCRIPTION | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3efb65b..175afb0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,22 @@ Package: tidymodels.tutorials Title: Tutorials for Tidy Modeling with R Version: 0.0.0.9002 -Authors@R: +Authors@R: c( person(given = "David", family = "Kane", role = c("aut", "cre", "cph"), email = "dave.kane@gmail.com", - comment = c(ORCID = "0000-0002-6660-3934")) + comment = c(ORCID = "0000-0002-6660-3934")), + person(given = "Aryan", + family = "Kancherla", + role = "aut", + email = "aryankancherla21@gmail.com", + comment = c(ORCID = "0009-0006-0272-7635")), + person(given = "Pratham", + family = "Kancherla", + role = "aut", + email = "pratham.kancherla@gmail.com", + comment = c(ORCID = "0009-0002-6510-0136"))) Description: Tutorials for Tidy Modeling with R by Max Kuhn and Julia Silge. In an ideal world, students would read the book and type in all the associated R commands themselves. Sadly, that often does not happen.