From 3c3547d16a7ef51cb56bdc3a96ad2177ff9f19be Mon Sep 17 00:00:00 2001 From: Zhenglei <7943721+Zhenglei-BCS@users.noreply.github.com> Date: Wed, 24 Sep 2025 12:21:00 +0000 Subject: [PATCH 1/9] feat: Track knitr-setup.R and update .gitignore --- vignettes/.gitignore | 1 - vignettes/knitr-setup.R | 15 +++++++++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) create mode 100644 vignettes/knitr-setup.R diff --git a/vignettes/.gitignore b/vignettes/.gitignore index 47018d6..97b58f5 100644 --- a/vignettes/.gitignore +++ b/vignettes/.gitignore @@ -1,5 +1,4 @@ *.html -*.R /.quarto/ **/*.quarto_ipynb diff --git a/vignettes/knitr-setup.R b/vignettes/knitr-setup.R new file mode 100644 index 0000000..66ed9f2 --- /dev/null +++ b/vignettes/knitr-setup.R @@ -0,0 +1,15 @@ +# This file sets global knitr options for all vignettes in the project. +# It ensures that figures are saved with unique names to prevent overwrites +# during the pkgdown build process. + +knitr::opts_chunk$set( + # Create a unique prefix for each figure based on the Rmd filename. + # e.g., for 'My-Vignette.Rmd', figures will be named 'My-Vignette-chunk-label-1.png' + # and placed in the 'articles' directory during the pkgdown build. + ## fig.path = paste0(tools::file_path_sans_ext(basename(knitr::current_input())), "-"), + + # Provide a default, non-descriptive alt text. + # This is better than no alt text, but it's highly recommended to + # provide specific, descriptive alt text for each plot using fig.alt in the chunk options. + fig.alt = "A plot generated from an R code chunk." +) From 5e58b0a30bde73ee885120b80d45dc3497c022a2 Mon Sep 17 00:00:00 2001 From: Zhenglei Gao Date: Wed, 24 Sep 2025 15:03:09 +0200 Subject: [PATCH 2/9] added Williams verification and MDD --- NEWS.md | 3 + README.md | 99 +++-- _pkgdown.yml | 15 +- .../analyze_differences.R | 0 .../complete_fix_summary.R | 0 fix_summary.R => dev/fix_summary.R | 0 inst/SystemTesting/config/parse_metrics.R | 49 +++ inst/SystemTesting/config/test_registry.R | 70 ++++ man/figures/README-unnamed-chunk-3-1.png | Bin 19772 -> 6244 bytes man/figures/README-unnamed-chunk-6-1.png | Bin 41277 -> 7757 bytes man/figures/README-unnamed-chunk-7-1.png | Bin 32685 -> 7893 bytes vignettes/.gitignore | 1 + .../articles/MDD-in-Regulatory-Context.Rmd | 366 ++++++++++++++++++ .../Verification-of-Williams-Test.Rmd | 79 ++++ 14 files changed, 638 insertions(+), 44 deletions(-) create mode 100644 NEWS.md rename analyze_differences.R => dev/analyze_differences.R (100%) rename complete_fix_summary.R => dev/complete_fix_summary.R (100%) rename fix_summary.R => dev/fix_summary.R (100%) create mode 100644 inst/SystemTesting/config/parse_metrics.R create mode 100644 inst/SystemTesting/config/test_registry.R create mode 100644 vignettes/articles/MDD-in-Regulatory-Context.Rmd create mode 100644 vignettes/articles/Verification-of-Williams-Test.Rmd diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..61287bd --- /dev/null +++ b/NEWS.md @@ -0,0 +1,3 @@ +# drcHelper (development version) + +* Initial CRAN submission preparation. diff --git a/README.md b/README.md index 227380b..c4f6756 100644 --- a/README.md +++ b/README.md @@ -5,10 +5,7 @@ - - - -[![R-CMD-check (dev)](https://github.com/Bayer-Group/drcHelper/actions/workflows/R-CMD-check.yaml/badge.svg?branch=dev)](https://github.com/Bayer-Group/drcHelper/actions/workflows/R-CMD-check.yaml?query=branch%3Adev) +[![R-CMD-check](https://github.com/Bayer-Group/drcHelper/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/Bayer-Group/drcHelper/actions/workflows/R-CMD-check.yaml) The goal of **drcHelper** is to assist with routine dose-response @@ -107,19 +104,19 @@ res <- mselect.plus(mod,fctList = fctList ) modList <- res$modList res$Comparison #> logLik IC Lack of fit Res var -#> LN.4 -15.45496 40.90992 5.893537e-01 0.2547068 -#> LL.4 -15.69685 41.39370 5.180082e-01 0.2598931 +#> LN.4 -14.65361 39.30722 6.118094e-01 0.2382532 +#> LL.4 -14.94568 39.89136 5.241523e-01 0.2441232 #> LL.3 -19.24379 46.48759 6.848925e-02 0.3326394 -#> W1.3 -20.55410 49.10820 4.800972e-02 0.3710183 -#> LL2.2 -70.79793 147.59586 8.398391e-17 23.3118491 +#> W1.3 -20.46060 48.92121 3.233853e-02 0.3681387 +#> LL2.2 -70.78500 147.57000 5.059273e-17 23.2867452 drcCompare(modRes=res) #> logLik IC Lack of fit Res var Certainty_Protection -#> LN.4 -15.45496 40.90992 5.893537e-01 0.2547068 High -#> LL.4 -15.69685 41.39370 5.180082e-01 0.2598931 High +#> LN.4 -14.65361 39.30722 6.118094e-01 0.2382532 High +#> LL.4 -14.94568 39.89136 5.241523e-01 0.2441232 High #> LL.3 -19.24379 46.48759 6.848925e-02 0.3326394 High -#> W1.3 -20.55410 49.10820 4.800972e-02 0.3710183 Medium -#> LL2.2 -70.79793 147.59586 8.398391e-17 23.3118491 Low +#> W1.3 -20.46060 48.92121 3.233853e-02 0.3681387 Medium +#> LL2.2 -70.78500 147.57000 5.059273e-17 23.2867452 Low #> Steepness No Effect p-val #> LN.4 Medium 0 #> LL.4 Medium 0 @@ -133,18 +130,18 @@ library(purrr) edResTab <- mselect.ED(modList = modList,respLev = c(10,20,50),trend="Decrease",CI="inv") edResTab #> .id Estimate Std. Error Lower Upper NW Rating EC -#> 1 LN.4 1.699273 NA 1.464617 1.990240 0.3093219 Good EC 10 -#> 2 LN.4 2.067034 NA 1.817202 2.321445 0.2439457 Good EC 20 -#> 3 LN.4 3.034117 NA 2.785528 3.283618 0.1641632 Excellent EC 50 -#> 4 LL.4 1.680896 NA 1.421435 2.018155 0.3550014 Good EC 10 -#> 5 LL.4 2.084252 NA 1.812372 2.371154 0.2680974 Good EC 20 -#> 6 LL.4 3.040373 NA 2.770313 3.299156 0.1739402 Excellent EC 50 -#> 7 LL.3 1.577783 NA 1.284085 1.961887 0.4295911 Good EC 10 -#> 8 LL.3 2.019241 NA 1.705807 2.342361 0.3152440 Good EC 20 -#> 9 LL.3 3.078550 NA 2.783875 3.366535 0.1892644 Excellent EC 50 -#> 10 W1.3 1.588627 NA 1.207649 2.091723 0.5565024 Fair EC 10 -#> 11 W1.3 2.092288 NA 1.686784 2.491398 0.3845617 Good EC 20 -#> 12 W1.3 3.171479 NA 2.861093 3.436843 0.1815399 Excellent EC 50 +#> 1 LN.4 1.700983 NA 1.473332 1.981769 0.2989080 Good EC 10 +#> 2 LN.4 2.067640 NA 1.826100 2.313691 0.2358199 Good EC 20 +#> 3 LN.4 3.032171 NA 2.791669 3.273468 0.1588958 Excellent EC 50 +#> 4 LL.4 1.684436 NA 1.432457 2.010475 0.3431522 Good EC 10 +#> 5 LL.4 2.085759 NA 1.822344 2.363961 0.2596737 Good EC 20 +#> 6 LL.4 3.037362 NA 2.775132 3.288824 0.1691243 Excellent EC 50 +#> 7 LL.3 1.577779 NA 1.284085 1.961887 0.4295925 Good EC 10 +#> 8 LL.3 2.019269 NA 1.705807 2.342361 0.3152395 Good EC 20 +#> 9 LL.3 3.078551 NA 2.783875 3.366535 0.1892643 Excellent EC 50 +#> 10 W1.3 1.588647 NA 1.208777 2.089897 0.5546351 Fair EC 10 +#> 11 W1.3 2.092302 NA 1.688186 2.490045 0.3832427 Good EC 20 +#> 12 W1.3 3.171499 NA 2.862468 3.435822 0.1807832 Excellent EC 50 #> 13 LL2.2 NA NA NA NA NA Not defined EC 10 #> 14 LL2.2 NA NA NA NA NA Not defined EC 20 #> 15 LL2.2 NA NA NA NA NA Not defined EC 50 @@ -183,10 +180,10 @@ knitr::kable(resED,caption = "Response Variable at day N",digits = 3) | | EC 10 | EC 20 | EC 50 | |:---------|------:|------:|------:| -| Estimate | 1.699 | 2.067 | 3.034 | -| Lower | 1.465 | 1.817 | 2.786 | -| Upper | 1.990 | 2.321 | 3.284 | -| NW | 0.309 | 0.244 | 0.164 | +| Estimate | 1.701 | 2.068 | 3.032 | +| Lower | 1.473 | 1.826 | 2.792 | +| Upper | 1.982 | 2.314 | 3.273 | +| NW | 0.299 | 0.236 | 0.159 | Response Variable at day N @@ -200,10 +197,10 @@ edres%>%knitr::kable(.,digits = 3) | | Estimate | Std. Error | Lower | Upper | |:------|---------:|-----------:|------:|------:| -| EC 5 | 1.447 | 0.163 | 1.107 | 1.787 | -| EC 10 | 1.699 | 0.159 | 1.367 | 2.032 | -| EC 20 | 2.067 | 0.151 | 1.753 | 2.382 | -| EC 50 | 3.034 | 0.152 | 2.716 | 3.352 | +| EC 5 | 1.449 | 0.157 | 1.122 | 1.777 | +| EC 10 | 1.701 | 0.154 | 1.380 | 2.022 | +| EC 20 | 2.068 | 0.146 | 1.764 | 2.371 | +| EC 50 | 3.032 | 0.147 | 2.725 | 3.340 | ## Model Output @@ -214,10 +211,33 @@ knitr::kable(coef(modsum),digits = 3) | | Estimate | Std. Error | t-value | p-value | |:--------------|---------:|-----------:|--------:|--------:| -| b:(Intercept) | -2.300 | 0.309 | -7.441 | 0.000 | -| c:(Intercept) | 0.532 | 0.177 | 3.005 | 0.007 | -| d:(Intercept) | 7.719 | 0.174 | 44.474 | 0.000 | -| e:(Intercept) | 2.914 | 0.148 | 19.750 | 0.000 | +| b:(Intercept) | -2.311 | 0.299 | -7.719 | 0.000 | +| c:(Intercept) | 0.556 | 0.171 | 3.256 | 0.004 | +| d:(Intercept) | 7.719 | 0.168 | 46.004 | 0.000 | +| e:(Intercept) | 2.907 | 0.143 | 20.382 | 0.000 | + +## GitHub Actions + +1. R-CMD-check.yaml: This triggers when: + +- A pull request is opened that targets any branch matching the pattern + releases/\*\* +- This includes branches like releases/v1.0, releases/beta, + releases/hotfix, etc. +- It will NOT trigger for PRs targeting main or master +- workflow_dispatch: This allows manual triggering of the workflow from + the GitHub Actions tab. + +This workflow will only run when working with release branches, not +during normal development on main. If you want it to run on regular +development, you’ll need to change the branch patterns. + +2. pkgdown.yaml: This triggers when + +- whenever a pull request event occurs. +- when a GitHub release event occurs, but only for the specific type + published. +- when pushed to dev. ## ToDo @@ -227,6 +247,9 @@ knitr::kable(coef(modsum),digits = 3) ## Contribution Notes +- If a code space is used, Use ‘postCreateCommand’ to run commands after + the container is created. It is rather fast. + `"postCreateCommand": "R -q -e 'install.packages("tidyverse")'"`, - Please create a pull request to contribute to the development of packages. Note that source branch is the branch you are currently working on when you run the `gh pr create` command. @@ -251,4 +274,6 @@ The work is supported by Bayer Environment Effects team members, especially by Andreas Solga and Daniela Jans. The Mesocosm colleagues Sarah Baumert and Harald Schulz have supported the verification and validation with extensive examples and scripts and SAS / VB validated -calculations. +calculations. Discussions with the Bayer RS-stats group, ecotox stats +core group and members of the CLE stats group regarding current +practices and statistical principles have been extremely helpful. diff --git a/_pkgdown.yml b/_pkgdown.yml index 07b689b..6dbdee8 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -143,7 +143,7 @@ articles: - drcHelper - Dunnetts_Test_for_Data_with_Hierarchical_Structure - Example_Analysis_Workflow - + - title: "Core Statistical Methods" desc: > These articles cover the foundational statistical methods implemented in drcHelper @@ -153,7 +153,7 @@ articles: - articles/Ordinal-Data - articles/Count_Data - articles/LMM-GLMM-and-GAMM - + - title: "Advanced Topics" desc: > These articles cover more advanced statistical concepts and techniques @@ -162,7 +162,7 @@ articles: - articles/Normality-Check - articles/Binomial_Extra_Variance - articles/Equivalence-Testing - + - title: "Alternative Methods" desc: > These articles explore alternative statistical methods and approaches @@ -173,7 +173,7 @@ articles: - articles/TSK_method - articles/MQJT - articles/Advanced_Fitting-a-biphasic-dose-reponse-model - + - title: "Regulatory Statistics" desc: > Statistical methods for regulatory assessments @@ -186,7 +186,7 @@ articles: - articles/NOEC_ECx_BMD - articles/OECD_ED_Assays - articles/Test-Guidelines - + - title: "Validation" desc: > Validation of statistical methods in the package @@ -197,10 +197,11 @@ articles: - articles/Verification_which_JT - articles/Validation_MCP_tests - articles/Verification_CA_test - + - articles/Verification-of-Williams-Test + - title: "Examples" desc: > Example applications of the package contents: - articles/Examples_drc - - articles/Examples_oecd201 \ No newline at end of file + - articles/Examples_oecd201 diff --git a/analyze_differences.R b/dev/analyze_differences.R similarity index 100% rename from analyze_differences.R rename to dev/analyze_differences.R diff --git a/complete_fix_summary.R b/dev/complete_fix_summary.R similarity index 100% rename from complete_fix_summary.R rename to dev/complete_fix_summary.R diff --git a/fix_summary.R b/dev/fix_summary.R similarity index 100% rename from fix_summary.R rename to dev/fix_summary.R diff --git a/inst/SystemTesting/config/parse_metrics.R b/inst/SystemTesting/config/parse_metrics.R new file mode 100644 index 0000000..b69ba84 --- /dev/null +++ b/inst/SystemTesting/config/parse_metrics.R @@ -0,0 +1,49 @@ + + + +parse_expected_metrics <- function(test_type, exp_tbl) { + # Dose as numeric: from column or from description + Dose_from_label <- ifelse(is.na(convert_dose(exp_tbl$Dose)), + dose_from_description(exp_tbl$`Brief description`), + convert_dose(exp_tbl$Dose)) + exp_tbl <- dplyr::mutate(exp_tbl, + Dose = Dose_from_label, + Expected_Value = convert_numeric(`expected result value`)) + + pick <- function(pattern) exp_tbl[grepl(pattern, exp_tbl$`Brief description`, ignore.case = TRUE), c("Dose", "Expected_Value")] + + out <- list() + if (test_type %in% c("dunnett", "williams", "dunn", "wilcoxon", "welch", "student_t")) { + out$mean <- pick("\\bMean\\b"); names(out$mean)[2] <- "Expected_Mean" + } + if (test_type %in% c("dunnett", "welch", "student_t")) { + out$t <- pick("T-value(?!\\s*\\(adjusted\\))|t-value(?!\\s*\\(adjusted\\))"); names(out$t)[2] <- "Expected_T" + out$p <- pick("p-value"); names(out$p)[2] <- "Expected_P" + } + if (test_type == "williams") { + out$mean <- pick("\\bMean\\b"); names(out$mean)[2] <- "Expected_Mean" + out$pinhib <- pick("%Inhibition"); names(out$pinhib)[2] <- "Expected_PercentInhibition" + out$tadj <- pick("T-value\\s*\\(adjusted\\)"); names(out$tadj)[2] <- "Expected_Tadj" + out$tcrit <- pick("\\bTcrit\\b"); names(out$tcrit)[2] <- "Expected_Tcrit" + out$signif <- pick("\\bsignificance\\b|\\bpsignificance\\b"); names(out$signif)[2] <- "Expected_Significance" + out$df <- pick("\\bdf\\b"); names(out$df)[2] <- "Expected_df" + out$mdd <- pick("\\bMDD%\\b"); names(out$mdd)[2] <- "Expected_MDDpct" + } + if (test_type == "dunn") { + out$z <- pick("\\bz-value\\b"); names(out$z)[2] <- "Expected_z" + out$p <- pick("p-value"); names(out$p)[2] <- "Expected_P" + out$pinhib <- pick("%Inhibition"); names(out$pinhib)[2] <- "Expected_PercentInhibition" + } + if (test_type == "wilcoxon") { + out$w <- pick("\\bW-Value\\b|\\bW-value\\b"); names(out$w)[2] <- "Expected_W" + out$p <- pick("p-value"); names(out$p)[2] <- "Expected_P" + out$pinhib <- pick("%Inhibition"); names(out$pinhib)[2] <- "Expected_PercentInhibition" + } + if (test_type == "fisher") { + out$uncorr <- pick("\\bUncorrected\\b"); names(out$uncorr)[2] <- "Expected_Uncorrected" + out$corr <- pick("\\bCorrected\\b"); names(out$corr)[2] <- "Expected_Corrected" + out$p <- pick("p-value"); names(out$p)[2] <- "Expected_P" + out$signif <- pick("\\bsignificance\\b|\\bpsignificance\\b"); names(out$signif)[2] <- "Expected_Significance" + } + out +} diff --git a/inst/SystemTesting/config/test_registry.R b/inst/SystemTesting/config/test_registry.R new file mode 100644 index 0000000..b45c2b8 --- /dev/null +++ b/inst/SystemTesting/config/test_registry.R @@ -0,0 +1,70 @@ +test_registry <- list() + +test_registry$williams <- list( + keyword = "Williams", + discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Williams"), + run_actual = function(endpoint_data, alternative) { + ed <- endpoint_data + ed$Dose_numeric <- convert_dose(ed$Dose) + ed <- ed[!is.na(ed$Dose_numeric), ] + # Control first (lowest dose) + dose_levels <- sort(unique(ed$Dose_numeric)) + ed$Dose_factor <- factor(ed$Dose_numeric, levels = dose_levels) + + direction <- if (tolower(alternative) %in% c("smaller", "less")) "decreasing" else "increasing" + + # Primary: PMCMRplus + bw <- try(drcHelper::broom_williams(Response ~ Dose_factor, data = ed, + method = "Williams_PMCMRplus", + direction = direction), silent = TRUE) + + used_method <- "PMCMRplus" + if (inherits(bw, "try-error") || nrow(bw) == 0) { + # Fallback: JG + bw <- drcHelper::broom_williams(Response ~ Dose_factor, data = ed, + method = "Williams_JG", + direction = direction) + used_method <- "JG" + } + + actual_df <- as.data.frame(bw) + + if (used_method == "PMCMRplus") { + # comparison like "0.0448 - 0 <= 0" or "... >= 0" + comp_clean <- gsub("\\s*(<=|>=)\\s*0\\s*$", "", as.character(actual_df$comparison)) + actual_df$Dose <- dose_from_comparison(comp_clean) + } else { + # JG comparisons can miss doses; assign from treatment doses excluding control + trt_doses <- dose_levels[-1] + if (length(trt_doses) == nrow(actual_df)) { + # PMCMRplus tends to list in ascending dose; JG may differ. Use ascending as default. + actual_df$Dose <- trt_doses + } else { + actual_df$Dose <- NA_real_ + warning("Williams_JG: could not safely map Dose to rows; leaving Dose as NA.") + } + } + + # Normalize column names + cn <- names(actual_df) + names(actual_df)[cn == "`t'-stat"] <- "Actual_Tadj" + names(actual_df)[cn == "`t'-crit"] <- "Actual_Tcrit" + names(actual_df)[cn == "estimate"] <- "Actual_Diff" + names(actual_df)[cn == "decision"] <- "Actual_Significance" # "accept"/"reject" + rownames(actual_df) <- NULL + + # Group means and %Inhibition + group_means <- ed %>% + dplyr::group_by(Dose = Dose_numeric) %>% + dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop") + + ctrl_mean <- group_means$Actual_Mean[group_means$Dose == min(group_means$Dose)] + group_means$Actual_PercentInhibition <- if (!is.na(ctrl_mean) && ctrl_mean != 0) { + 100 * (1 - group_means$Actual_Mean / ctrl_mean) # #$#%Inhibition = 100 * (1 - mean_treatment / mean_control)#$# + } else NA_real_ + + list(actual_df = actual_df, group_means = group_means) + }, + metrics = c("Mean", "%Inhibition", "T-value (adjusted)", "Tcrit", "significance", "df", "MDD%"), + comparator = "trend" +) diff --git a/man/figures/README-unnamed-chunk-3-1.png b/man/figures/README-unnamed-chunk-3-1.png index 26f3c17637091cb1834d93d47ced1d7cfe99906c..05b6e502bd676700cd28d8b90de4cce25f87f1a6 100644 GIT binary patch literal 6244 zcmcgx30PA}wvHMgYyu)+Ln|PwfZzfs0m57q1SA+`2LWYCN0y+-j)2~%$c`W=`&GIX z!=fxk0RdY;b~_`xVNv#-R*;?KRj{X>p6TyGN@pFyFvA}G|B514JB1%F136I5^nQwsx7MWL`L6cL5RqOhP$KoP-1JAC*s zXa!AJ6p`J71!V%3NW>CBNy8?9hk<8*$as7lo}7n|Yanh~A)T60kHNOJe|88UvIp8jC?=u^Qs= z4J;NT0n11rG7^9pBHI$^2Ok!Y0wrrWk37s`O-)U)P$*!I^{N@D0Ufph&_A5V0>)Tu zGeDNbVxcoeP6PjOUo^74j6!X%VgGKa_s(@ip+sAZk3$xL88ex@E)v#uH|vclIlgoL z@5DvBJNMZq`bXN@bPtMl-+Qe&b^LGVJru0+2Tv}rSg6Zyd)ts!<$7B1PVRPiM+ZcBfW??ta6yriQi`W{qvfb=cJv&{u-gNx zi@yYPuBCQyF_=>${gp{qUS|$T%nvV(TqggLVWx?j;lR_jZ^V9*658Q=$aHa|tEu|E z4#q^j8B_j+($f5~@7f(?2=aHi6OBEB5%+q}8$5QzF?NdL6bMzbf)dw%y-_h%9iAX- zFIiT>RIU7UN&0r%feqGyviS$Nd8weebbb2H;Im=-4)omf*2%e-!h<#8s#5G0iT4al z5nNaj=+z8cXU=6J6E|_Oj7b6E?2Y!!&xUg2eUQ(btNZ9um?H-JIfOTC!=~oN!2vBp ztr?%WSt*%7|2moUEIIT>&9#yVQb-0*aOelC7-ud;E?5t%8KPdBBN6Xz1 zdneN>J)<;<>Dyh!uXei3W?HnVE+uAXo(<3R9Bbp<)3dB1J^tymd)r8Vm9THdOvLsL z`PFdN#vE6q@WQNG)g|*Oxcob6YKi@jNx^-m0%Aq7mb^sLoX2Qe@la?$e0u-#N7s^) z7$m3t;b~%zB4fF{)st4~r(7qq^hH5U942}+IFC+~a&?S+>;s-_zRhnvSU2utKFiU1 zrx)wn=AoD28Jr^2e!-_y_X1BEIW&Adp7rTO_`MCU;ORtHkFpdPJKa6Qu)1eLcNd2Z z)7{X1TqcwaV_Kw|8K2wprh-M*I@XUane3EO-0_2|Kos?3jeFMWo_xj~v9@BN4tZuu z$r;zn#dnaLf@)J%t3YDay&ogA$&~8QL9?|NB8*?m<}Gj0@mo|CInrdKf0cO4krM5?MmcY*Fqw+B zOw%R-zoyi@kfxa8{eHX6F?RTh-nCD!=5$?aqfTh*p5#s|6km#-SvcA^@N(^wto8+F zzt}7}`~maP+XmM6vU)3py<7#Y)BffIYsb7KORqpxwe8yzn=VY?#z_h5xjLtvJ~iBo z$Vmjur5rs=#j|G%Q7-p_(+MXynuRza(yzhZra3ADCQJw2P_)DwayQ;o(n2()z>= zP8J>c;{f?*pdK#%TN;)?DQ(Z}!{0|RR35k8b3Wfw(4qjzoTl*fXvHS;!tNra={bSu zK7tCYTHC|{38|y3R54Ub!XmWI8K2ytL{f-gV9M`zn{oJYyY7I=ilUI1^9YP!#8Jv( zXahRRrc6o^=6nToU4%=67I~l}I~n@)==zFy$H&6Hlk0jwXVD*ef(yZEZG6yx-D}g7 zB#h|Mr<_g|;?%6}do1Y_HZ1VnZk@psojD zd*bWU8t1*m76y~XlIBlLYJSQf@|@_nUgUex-rl2}i+A;b?For0sS-gIVlqH}~*aoU`9J(Rt%;);8sU1@TQsXzBLj*0F=)rdh z%EU6MTn;ER6GP3Sax)?j{hOWTXvXCPURYePy*Uz@e4O_5BS&bP&9z|2&6UdT6Xb)b zBBj&GWh+)q1hj^grX56?(K6zMI(UOS8)3N0e<~mz6pu3c-|L zvsr_A=8lqreO4d1zkV;Kt_XG@3fc112O^;PuYyh5OG1G)?S!_S`*X*C-L(HrMMFwa z@&<_l*0UmRp^9b0_YJ=&G6p@I+PUGkS#?Io7_e2msmP^hW7SAF8|x><=5z zEsKa8{8eL8D{(>Ig1(lXfsmJ%`lGPSQpu2ghxQ55wm}-Yy$qMB;j51gqCps-XC$H# z-XhHVBka%R!@-4cg(lB}=-=U(9RjAf_A@ja0e_`EIddMJT2_l+M&kji1eD z#n_=|#G;Y;B2L`#p2-Ie&V2COn$hgjK-gKxSGDtXgrbB)X>$xj*XsU!*j=dflnVUz z=U}~#@LR==1{J-#(3!CYgxxmakJpuk=l!QvXfH^2zo#Ir7j<)0Rbb5;kuOb8G4J_c zrJB8@!x$=GG}0=Sdq@Q~yFrn40CT)$K(8volnX{9pxqzsOs7T9-(bg3W)%LV6##;3=*r~)XNW8E=8NL2JbR$LRGRg5Ce0_{?#FelWKO zAqgzMr?wv8vK4`TK5<%LE>kMkA9<-qW`>)X)6#vnK3bpQfZNKR(hQwp!gd{`MfO z1RA~~crv3_piiFZ;~jy2$yS58jB{jLRrG``!~pD@9j^Nw@s$;F^-N5NyJe(vRoQ}L z&~t?v?fPSHDO9%kptQ!!pT^Xa!a!f~7!)AbjsgY_LQe$z4ecYy$KsJDu>DOllsK-& z#o=4g1`B|0M%2x}G0lVYK(XzK?Vwpi$0*G&@H)Z+G)%IH`UDBEN{%iBXtTom%(}1j}AK_xmg1;4EyYGHM4-m5>Zh8a-7B45zm# zOjF$JHeL95k%@?9R~Zrtz=GvC3M%!+CkmT|(H(3~G^I<-2{egYD1#BpC_hdtaT#pN zmG!EAn|aR^wDK~L7pRY*N9G3$*vr;!t*yUg|LPxGF0!5^fK%(o05d;RWPkhib*HV) z(pk=u7TTa|9~7Thn|ZFhcSy=u7u2Pph=4e-nZ4xk`~dPeRjhjt;E^L}KOZy0r7AOG zRl;?o9Qd&bGs#j6)43PQ2X-9Pqj<3Or_dcYzyi+Dxgs#`TmG0xD9eqvuk}miI)k`* z+5X*MO*SkJY8odB+L$+^pfAoFypmg9q@-+tl>j_Z0qCObxr42aU-!81om4K-^D>8$ z%b0`<5N$mtRJySXJ+mbm0T@dXut9t2aY7-l_L9~PV%~2Pg&6S=eGh=du$Dx4M`Xqq zhgXg^6#qy!{`X;g@Zwbi`l5?qDVGXNlcXTJf7#eK)sXyl$tyOFoCRR?B>=Dh(*5Ju zM6O_#9J3d245&mSCjq1v7C926j}@p=bot>z6!^*awH#YA3tP61e(!)LiEm*%~QkH5FXMuExi7lrQbrXUW^zlh&{5OqQb!1k-pc31v&iQi@=tm1vHVy`Hq z{j*u+3Ej=bIh+&nwfqO?VczqngwjO-jd7=Fe06X%k_YHaSOqSOGN6;6PE!g2SK!#5 z`)2mf{M4&DUN_X&_X9>LlI={g$iigFSW@(w)@L0>GJ|@;f|tt^uk~-6{}y> zM*D3XI8Vlwg$idsF;GZayCC}3&?r}B=R)7zQ&H&-8-rJ8ZUgo&*l=i=a@)G5qEN{_BK&$6-ui@Ic zL7L5Z|K_TV4#>Tu5e!v)vuMUC!qhkZr$r%aJ{z76@# zpIH-x+SO??&<#F^kzo{^_U5K2J9W(C@LUe1>l3~^CZvw_{7{^l?)?*=0e$=_$oZ&6 z=bN)M_TFs$xW8U1*De2J*PxI(rwY6`*ZoflqNhUmt38~I#g`(m_!~{Nb4lgod49MF z?YTjXyEvD$>o~o$3zEq_@9Dy?6fhBD4b!O6NJ`Op)zGueRqRBkW0~;7n zvB(y6^K{`=^LM+X2zfgaqmcAie&2}@#O29%UiR$0s&zjYWrWRBK| zahTcXeVec*gAxCZRXn2ZyJge){@ z>0N^$?JPQ9lL7MZ)Tv#Wypi{d6JC`$ zDFWUv?35%XT}Z09P~EcC>7d}Lu(Yxgq2i;C^ht)C-nmOv$e83#xIF)Jp36j6@2<`> zJ->Po(3XIt!2xB{7^ikr`0LY~`ILx%WVE%n*qwPK3b0S%buVd>%x`DnzxA?56Napf z5j_qLkNjynkZ?u*G2sGvy0phXUBR&5OkwW#flfP&djTq(VD8T8)t)ZQ9-MjP<7w=q zJXWDK;@dTn%2Il@|KbXMi?c|z)Q^u>V4Gt%39#lswyj{m7xl^!$(f15tH{{O{Kx)! zwYpKK&gkqdc)2|Cq|+%) zO_J$h_0B~vJUQGp-M%0-v?stx*GVT}ZFuh1KBI+3(d+6Rat^<#Rz&j*M%m9*t!56( zJNoiZo+&)o8|y3lT)C*~$qTqvhYU5Chko>P#mJH7H&Qt+g$c6`bc{z%<49HMvZYg3 zJ}sYTc9%TcP&ni9cjwe5q39PJLRTk6Yq5v!*;C4E?o~4Urz2o;%jn;)6gU)`J%srgH<>v#=e1fqaZ)i);+n;V@s9o9RQNh#he~XKuUydO^;}p5!K= zrCO3b=QH``=SpFP3FhQ04#R@Ij9_?sK;dPm3;h@ao5f{hPt2!<+H&Wb&~rl3&yv?K z_}H&$*N5e#%dX8jvD6)BE%VHdG}9!0Wi0e>d|q=V;rax2SF_T66MvX-6@Hg}NEgTY z*!FTdM9*`emC&F4anezPh_8^huMTA$tx!mRUY@BJ)2yd$NU(3rdN@V#s!m%Nh~-+V zOR^5x(Wf%Y8iL9-clT@gKhLZlp|h#r@u+UqtFEAq4P$QQ*(XC$vtMl0 zmi*sIre2B;YK}<2$?7=|hjGGoCX4E^y-BIKf+1&q3rt$LQ_CTrsXA~$MbyrJSaJW^ z1apy?gHSf!^;y(Mlm;GK(o zbx&3i=kBsTx_*NGt@m{2;Mp9>!BeQ6uvx6yuX1y5Hp-BZC6U7Z%H{ew`Ma8N)XM@V zI&7n+s&$VOTpBqFw!`ln%G|Z>rYVlh3I1y)(ER-)=*nIOHvb9KwX-xXFCbfvbkKW4 zdPO4q5{$e_^d6iVL-#F~2Y&Y1c!z(K?RKZaexTO7!;0nyRbI+*=f`SP?K0;H9%4R3 z{LWT}42j9J3igc_=*jAZh5!R+zL)*!)P>cURfX;+g`aEsCv`|cf=RrmuQ>4)bo#E9 zA>{p<-AeMN@oHhq>fVKj7C8&~Liy3zF?4q_}z2Ig7sL@ZJj#!yA^gKL>5Z ztQ<4(u5h3aj+B6l;O9ik6K^D2%Us%-92{S(hT4Z8t~?tayt`-+_TqsQ=|gXDQA5T$ x<5NszO{#Te3%^*j;EtnzyiWe@mhCNTTWwVaN8NroZ}xu+j1A0=7wVsb{|C#`-?#t( literal 19772 zcmcJ11yq%5xAhi9Bn(1ILN^FVOG<-oDG?Bnl5P<}xzDlJ1i3 z-oU>$=R5bi@!dP_|BvxI&KV**-giIGde)k2&bhX~qP)~aJW4zS0&!7B8l{9lU?n0D zXT~pJ!Ed%#qz&LN+?UeoHVDL}TFn1v8Z18x~x<0&(R!i7*1;iAWlctJCG=B;dB1L@|o3{LXnw;UfS)6GrJ2nO&{rB;(Mw z?ZG>P@FYW%phM}T$bIz4jdzv?RQQ(%3Vh3-9i#Uv45#iVh`N#c?C*|wY>tJ$dv~2Q zu-txm0j-QcD7vpZoy%2Z;aq?&Wjc@m&Zy<$EzpDxh}ga!s+=Px}1M(1$}di4H|;0 zs;aK>TeNzNBn4gLcXo1$7{3r7$V}uh|s1 zky9SW`*U!QV@`9_(Q+z(j0fMEZAUsKu}m16m?*^F>Fn!M%~baB_CDI~)3N_S_KgLB z_`XjsEXr5QNk~ZeAc|e7&M4Wq)?*}p} z#LIo)OwuSagPmLM$qYO4B^R{)1NTq_>#LHZ5skxd-Y8XSHsFY-6CQi=@RX2_g zS0AKx&39**7#p)cE&lv4h7aD#b-Ac-qk-L46=GOSO_WO1^@Cp(e2Awd7KEJ;x9X8c za1Z{byDK9NA+(IiPMfn<_#N>gPw9!Mh3s2hcUz)3;BB9Er&|?ha^~R3ZI2Ur%2r_1 z66tgC8f-bmF);~APpQ=uomB8ke5MH5Jhj$`i?)Js@_lI!q9Fd>yg6s_tF3K$X`q0w z;}J(PEb&#At`4yiDk>`UY>cIK0YR^+ zDo3M;lE;+OVz`vZR-wqOH-N_9XrQ#TG%@jd3vW-((~@6O6r8%An(TAO!#9#IUgMLd zfB)(%4yhIQrc_(5A4?PMs3Dhn<)BVDX8l|zHboreA%`$RyxIQwH9b9j+7M?^so&F8!a3U8Hh{7`@U$c4wn^J zj#a^jA1QapRm)3;SceF^nT*bex<=rGzAxEJ zl`^-+YhK3*Iqa;j-dujSCm7GDyhpad`#`s+DZV>+HRgaUfmKn*E z&W-JzWOL)BfYSGHfgFF9oUvYrI`m4+SP z(Q(^;lJp8c2(z2jC&!17S!ZKDld?-6?kpdn(R^@Y5TddX%x*pttpZr+V^Yrgq zSg`ZE&9%qD@|ReQXry#b>*W9AkepnI_oMvlbzT;5lM55IzG4S|QXtvFfZn_1@_qQH<7ONG>R5HP^-MD+!=0K`-W3TbpzashXxjUV;Frgp?K<8u}z# zWu(MXhfs{N-R-*j#1C&22?fP7CrPiPHr8b17Zg2Fk!h#?+IUTLbTs526LOzGWiL#~ zqF?@=KXCdW#$d9kk{!~N#|mjv8~pq#+T z=NnG-X8Xh$Y`DVjl!2NUr^zpp*0RyM4$0c`lH^*$G5}Jnaa#*O6tR_<|O3a zcau6zl^#E4*&vH*G~`lM?JF$gX~`X87bx~-U-FPurI3e^%onFXUncFJ4ErzQvr)9aT zzR3x0?h=VGVW%G*);_wj8b&u(PYUtJ5YGHCQJFJS?^vDEEaZ+jQ!Ty#J%iL zsSuj=_wbwVj}+GoMLkBB0RGI~#D$NYGJexpDZ3Yzl3LXD4*w9O6e#fOY_+Kwf$_q5 zP7d7h)qp*vueKj*z5xC zt)sWF&h?&N9zVOg3n23f2ncB8@SWt8xg9RV@Jys@G01W9n147LBdpG|e=(Pad3Q<@ z*HCgD_kq2QmSLW3C5j{T*2Dx_5;}sfXBh`zAO1cNYeXW#CY$S48ra9h(aOWAhLC-Ec>kMojb0%^L6G*$pwIz$tb!7b^MxXI ze8gew2p~n-yx0kvo0&Oa41oO_l1hCokd!U!aYlP2+fzU_MF5upAPT&kQOtV({ymf} zBLVBRafzxQn6R@ktYKti^!4=(te=Do*_-u*<;IPgS1i6t5hsJ9Wo2a*^zaFMUrx)| z1H|>nTF%coQ|@}>q7v78a#)Z{=YGJImd+vb`*Dp5 z#vd|-wORRIbp@;sC<^By<<{?~mLdRqH#@{~l{1w9%lS7#DxGPLn7s*I3DtID@XY+Y z`mZ!IHm47A--d@Xuw8fM_KWoE102TOqFfAa-np|^&>`xgw8r<1g5Yz_yBno(->vNI zZa&R5Q)Z$Jl0=5~J6%#f#~dM>sjRXVm#D}DFj7)da$t#X?p>21WI3oDk}099tbCBe z$~5CWhV`&dpq9qQ#sWg*CYYL=>jRVuTWf`VdFC!GPg5A<)YQ~XA{lXUaqN@V)QH3i zn|`rLfVpNx2j5?vl}x!UAh6#W%?%kOSfh;ikL@=oO=L55;tc#zP3`t~>E|9ZN90x? zA7tlN1=!;tm{zHFR!fzc<3!yKI#Z-@2*^2&n!}+La9HZ^e8j@>f>A!!6c9tL&&AhX zUgs~<#A?0t;8sWopb>s|yza|A1))O{MW>LTty6sr=zr$>RY56OV`w2(N6H)8Xzsk! zh0+O`GQaGr*}A?GQ+-HxYV}dNWpA_7EqHOj+1$D=fUK>{?fVewFW7Gd2R^nq2pt}t zkMQ{z&E2H?QucekpVP)0nFmus*l@KA*p^dM?a;#UMJacDy#LxaOd2&BQ6J%YRqR;p zV7?j2AoSFAGkv=2X4m3=JDkztr14vvoWG#LSkvFRbLT|AiF8CJ8!x*V zxacH_bNTVgAX}AtrSen+?}B=PsrWgWRQjmE(S@voRb(CX)#-`jnc9`kDs)ibi(-ws zx}OA+b(c@&tY#{Ae%m6?)kx`ac&zuFyP zEf7SN@twu z^sp)^-2%5*JV;{rAB0ny9Z1G^@-3%DE6h}*e>`S_9N891_U%?*MMVXqpNNwdFQ^(*cE$~ta0%|-*Vs?4W~ zHSFrPb)L8%=Gaf7GUgx_U{}3=N#0ivl0MnHM@G71J1VTbv3A#W_ltFdyhcgU_nVTz zkAkQ^Z0-y(cz7_*Vj(=SlE#x>E+~lI%$41mI+(lXzbnm z${rh&Ba^0lwfnbkL12t=R~LO0`>m5h?VjN(w}(|# z==*TNuV=7z=)1-|RG}uuUrkGw?TDR7-%d)xKsBc4ifi|iuE=^iUi$o-~+}gt&7KFWy#AD~S$%p25e9_ww?}Qq8px*nn1cBOK27_uGnV z^kGeqcOGZRQ(M@Ne}4sl{IuXYN(jdqGDgV8oh0sfzj+fYXeXQ9%S?h7`f2jGGb}oq zf|{BwtO*)W-IE5WzPIHl(2oSq?NVJ?_xLj5;~bnHlBVn1nCQsPi$=A1@aj!Anj z6!KOKc1?Xth_6?abn~Cg!_)NrL5=~S=~SIRF|=c{($d$H6B84mc~ONHH_^Myi=#lS znG7xxF~OK+^AbBGPTY~f52gIlTlvbY7e@^CqhATsZ#Pev9>~a8ZP1Y}0Q`oJLB_6m zJsG&Cws?{9H{B zosABp*D&CiMI~qeFsJXuYxY3FS=a*>5fv3BW|W`ij|dy7_87|_@&D86K{museDkJ^ zfqs0OG<{wEth&}*ds;##1?==UyTzT=F$EOh6=>Piu*F`U@!Y`2RsgDr6Hp%n!quE{ z;L&mDG7w0J7=^5=TK^J~$v?lAj16-jq20qQd17pF#@L z6WKIt2(lQy7hECAtm4GBQnV zZBLj;W(nt`xxXA83{)I;b5u3b@MhW4VIfE;8oqS`}JYgM8urM60QvIG3otYJT6ipk1W5uqD3> zi~|wR;jVzbv$e75Ufc%8X!Xwb7|W`CV}Rm$d3h+3D_3;g#YW%SS>3KUSSWaQ`SQ-X z!6qw0Jlf04L!Om%aof4-F(LsDOfapO`{wLJWR_NWu^hvc5FtVwH);IL1^|nsq$K4D zF`UbY87*wL3<_x9`T>3_-kp3}g7Wuw&446uQEClw^M}7%5L15HuT@9dKz$9>`LR?n>rxa!x7a8>1n4$+k3*G(g}KVJ~x2Kg&1B*-&_ zb=&;);;-ot27+q-#&84- z5~>H9CO}Pt-Q8j3GDX%m)6x}D33CrJ(n34MSGOERlY6sNzO*injb$dCL6}R_oE6^f zl%lm-mPZZO!Eq@aXnm5+wCX#;OY25oWi!{*9_OTTBT9&l2_dcri{3#V^b=SIjbJof z%(+sVIf96gCF*HZiJT-6?&8Wy>pQrqH@o9!mh{MdRxd!u@X8Cv@uw-zEG-W?LAwGL zVr>%hHjRe)P^<^6Q=!n}d3)tTx4?mgeR*v-R=|eU1bPUYs`r02jW}zX4Z+mFJ6kRF z-$t5^e6xc{-h*aD@h+32r|?2gW_PL#F|xU_aa;%=jwpmyfJFEQCL!nW7}AEH0ZK|F z*Z8dq4j3N3wOiaEyNI}c86x4fw8ii*x#mr+yxD;a9oNtxFC0%UOc)S+BV|*v9LaZ! zk)0W4MId%C8+?zsK5Y?^sQLZBErIV|E94JVdz`F{ltZ{L&CT%xJqEOrfc+7a4n>k+ z*1a*06F2DlAg}gjt18IJg+Fz3;=|OKKstPP0QGc|Z!cWB!~mK5I&@UPr99Rahe-XGYBd?@ z=|r7CLaBVw+y~l8L3BSA*eYnfZzK;74?~Hw3Vf2Obe}mwa6y7PP>&qw-=jxLdbbH` zIpv~{CUoMF$(X52fh=K7exFoxwb@Vq zycjALaaf^JU4vo`n_l451dNN6$R`7*|ABE)o~V8(pVA3r?ADeo6c_lUw<4N>R>Az7 zq-e_X5gNe_yR`*1uISd@US2x7ltkv4D9Am`{QKYw@&!9W(1S z1HxV-XQ$>hPG@K5aFiL~56?}34Qg*-2XoZ&^#A-yGAsH9O*j-(>+xnlHHm+qxwS4s z*IpL09S3a+k!Z-gC4~VEZ}9$GPU-&&BK1F)%)yGLS|1cF@{PvTMIMll1s9Zs;)uA6zei_5zfvhg0Yhg1N zdC3Wkc1)(JhB<7o$8b+ElQJ~AN||4YN$|Yo7~qLB*+Wzh7{Zzi^Ou&)|3V=^6DVc2 zidn3R>``zV*EKXGhmiXQbhQwdAErl-RSb zR9s?)myB`L(3L`HW~=6cx=~P&4{;`rJHWCBOuVtNv3xX_x1XT>(w~WmJj15_^6}%xaYR7sA!OUNYozYqryw|w{N}oEt*oqka(omP7M39&xA55< z^Nx3Sw39;u1M%_jkjbzx#g=34aMeoSwSMQs{C&?tUStplb`BnZarj;gUU>xk1+W*f zBo{H)faSo!!O7Ju;}R4UWMD{#lZLY0UD2YYr8P0a97dvi)ins1r6mmVNt{)oVtEFOQGmkZ&5SUT}w%gIo*o^~2u| zem4_X=_Tg0VF+vzP}bdD@GH-I{Vx8ay}eJ86z{NMw*5{(r5EjO{klFKkL5z>D-q*N zute4N%Y*SEF2xojlq4kdq=9Wyu<>k1y70K7^$y;sDGxj$!cQ%7rpgW|S41@BpNSBf->BL%Ss zA^UUm!IqBu{tT$bz@69D*7`FsFc?G86f~bEcmCT85NEM5-P9g%`jPc=$1z<4gcF85 zidpW@Gtku?_rk_M%_>H*l~I3)iHI~xEM5q70bqFZ=FLAN8l+~3x?$^S03>^N1z=_J zbKh~qP(UO?GXhr!c@(GJ!)#8$!U*T+XI zT>x;0(27;L?&o)!x~^94#{RvKglLes!rs5{G2`VQN|bmFstXj3W{NU+k8$jNA+O!F zwRbHuk#v+nKLL0jQ$p2t+4_@bJtK>gdK$ucs%wxbfKxASGMqFn(pY9paOJXJQWJ8} zQ{MsEIQMZzFda8Ur13e1qEzqU2@%Z5HRl;I*!*79b0FZUzBk%JKj^W}LLy#5XVn*|g0=07?NuZw5 z!(sQl3$a>SdS~TL>3_+fZQiiK`$xFmcW;meZdOx3Xd~L;nAYpx-gU19U%>CAdpO7} zAnhNGO3?C}g{N$smWlrIUk_itTx*VCNl8gD(AO{Zs&?7^5)u;fcS>g21A9V_cI7vK zVc^`@UhHGURC4k_5oGy1G8DvXmM@Lrm{8WhF_GU~TzNy?eHx5KVLTs!n2N<-EU^eg#bfAPhVGuNr52xf)pMn zV3Q7&E({0>*m!sF#?>F&ZLEqu88+grpF9d}s%QD7b$%HNl%D)|u1RWTd9<9UKsa z!uG4NUb=YE&Vm^pa=cNDA8(}Yqt{wM=G zI~nts%mDjdW1}?V9K04PlGa)v8Hc?!rqaAjy!*uvQ$S`2{{?P!{Z5VeOcC^RbFO1? z`@qu^5g}XeK!sq!rK&kAP6H_yBJc$u988t{@k2gN5GW9M6x?CcgjcU_gMZ{@H<%kh zJu*^{9Fs;UVmbQLAU5u}9Td)(gZu-V3L1Z~K18s8m3r}44V44B5@&rKt7P}z*m!d-7*j6s0N+6vqbcR&!0#3z6L zTTaL&GDf8%nr)e_&lBo%@E2csLT;@^Cza0N~W=i5!%Lcq?qT24{)S7N_UcZ4MR4`us7 zjq1l$_Bl~!V!C=6+j2WJCjYe_d9)k@(UU)_ymk7wYdKF5Es_75<~8D80eT{T0OPid z(uQ1T#Prq{#ZmfsAN-(LL8h$R_L5Cwj#0H^#k^NSbo4wLhYe3bp<{ShGe@Nb@_Jc$ zIT%Yme`dv??B3pp)3-cLq_=DtKiLTiwBXt4fUKRT#)^@wPE~Elyv@cX0={w#VX|oo z38G+R`YVy%A_+iGT|F=bEm{22|GF9Zj<2iE6}@-q%qgjoI8ATT0nK}(?zqqegxWob z6I}oI?^DUx-%F?Vmx2_9&;71e7|+7!L{Lxr!ZVok?4Ja$qeI3 zs-T?=D{0Xph$k#n#An25AR3rNBYRsvNEnD+5B=b0I<7b~>NfejZ!Z`d(E%Hj*gri~ z@<5HyyV#L0SGjYo^CJbf<3((Q6EFdZjvq1c4@@t|Ej?`x85RUr|Q zQ=Z6EUlB}SuYJO@W0qs26cpWegiWj>hkM2l1z|3}bl4I3wVsEn*Vv+7Mh=V6q=@4z%tETX2H^_GVU~E+c*?r=){FtN3hdG+--3nqsG$J2kz%ZDQt5ps;TNuQCaa_>D5sd}_@FNR=p6G-o%=?Td z5oQlDXI+I3(AFd<=M@()@6!2I?_P_#hsO!{AUD8kAWHz->LiySs+Fb`ZNm8QBR$as zEuQBFPIU?5T>~(uY-6@M<@RhLdXU**r{6U|{$w+O-eF_B<}A?m;{LFU*Dph5;zdTa zILTn0QcDP@tv{W$*2MtZ;^X5_Z>ZMW0&zVAl*(&CKOq585csUEtqIu7uEkwI$O0RM zaFR~zg2t~kK}-i3nwpWZNsWV$y};24x%_V(ooa`uQa%IPl5M~W@xo3@fSth+)R(Q= z@rVWTp{Kr8KVe0Ut|D_pcZLGo_X{XTqF@k$CQ~X01AtFy9;Hm5%d|A)ff-*Lq4sHW2xN4WKQ2Knw6~yQ-$#bF#eJt|e4zT-vACbs!;gzwt9s8XhS$fNVyMJHyIBdNeSh*2 zBQC|KeXhEG><$SUMB4gmvXDQ9B5 zl`%LE86IPtifmCWZQVvezP?fx7GGxi%$3DKFqKTnYdwA&TU%f6t@q(C2|*@D1&ot; z#{!ONpdm0rpV10=3%q?nlAC+$2EMcxBk8~i2z(DTf2KSearNh;b=C^`h4^I?nE|#LxIQmN__kptEuC!+UZ2jw~KmTrrFrWjW{h_JO!Al7v zxqtk)u(-H5Ki>rGsW|A5-vi%Mi^-$jFZS70Rk@m2(MKAA^{v=`S;N8}Xj;(B3N(IJ zzIbZoDqO-7Ek{p8SbHTj&v|>R);BJO|MJiMxrY#7jAHtPz-a;##Y4Fdt&KnGM?NcX zU=-$V-jemu15o&60-p;7zkZVIP$ANW2!e?R6)^sx=Ky`g4cSwF%2f>%sF)k8*eGl zM9Uc$j9a}2j;&vphY}Twan^I3OR(A+dppkjY8FqJ@(k42#Z_p zNla@3sArZ+Re3SwG*ZAaUhZ~iZ*c(R76JdV3=2EniDA7FI=X;%HLW|$>V1ydU5T(4 zo&)F6PZ&uMgbWR&K$Y9!N`D^R$!)i2?*a&&@8?$xNghB(bDG_DZrhsYIi@30r(*f$ zqF61lP-eqjeN?=~Em#X4mv2s+#;5MU!VNntuHe%XapvrKwRY&M=D=!JLiOm2I^7qQ z*V;|HS8XZ}niLWuj<;2xF`hfb9C_V)rlx;p+hV{^sSPN)WX#d@@eBi@#+ApT)vC1{^3sS z@lhNh2}USFh_6c@?@Q&qxaP(gI!4@mp*8q zb;WTy4{xr!41M})#b!H@rN>($aZvCW4>PI7@%hT z+VK+i0=H*rZnvG)RlDW1k3vzaijeO-UEw(Wo~~vo+TY*L(W%xpSai;At`Dpaig}bK zi#b)QIb+x5rC%DiE7=`v%>%QJl9JMaI^c0~s002#o0gwXTPhkG8=3wvG^IV*2=h=} zb?@*UrTKKnO3C`Tg8ThdOorBN>+Q80$TtEX_Y$aeQnYT+V`ZRQ{D_F3Tsx7vCl$SV z@92ECafiLxudXd{`D(Ol1G5iLa`m3*1fRiTPv+F@>~A<}z6tOG#b6WJ!hI6&0Of&GLRm(IgM*C~BD0hZ}v4auV>MxK{UWo2Tt3;V^cJ&Cbm zCq32cKHbTY@t_-Jhk}rlO$b@JPcK<2#829GmBs-}AX{;o8?!bZjN(zo`kGiq3 zlYzHQsqvz5Ki$ROyPmw^GeZvKsplCzXit<#qb;xvq7vAE5)0h&x&`{1^#B)aOIp+~Fx({oru2PrZHh5dlrm~4=i1_eM%Il7G0MzG6TY-7W7P@3BCW2j z{)|J$M^)X&pTn^MPFE20wI9~00KkXeFx`*<&H5sR%%Qzl`ErdLGI^@HGv``|WCcrh zBu59uonOjn0R>1gUrbrXjO64HIaml261qW^15`iE6BeDRQRpYBz_ixx{sg6$^CXZo z!d`mr0s(>fKz>@eVsK+%HXNrh_rn)pFZE|)VloAr|1b~XZD+R~msKN{x`6}Mm1@n` zk$%<}H8!P-m12)p%HL{tJa7c60>aCAJ8P!M0tjr5NFxfL8_4>D?c|<@t^K#4v5PT8 zra92XhfL2ht&VlOuSqzG`QacJx-&Y2Rx47JnG5ps-;$cBlAk?W7Dyc}(;gRQITkOX z|7N17FP5eoY6OY`C=HwZJqk%DSyk;nW5s$ssrX1nUreL?DR^R;j0(w zeK7lNJf~FjS?Sqlm7u0JUL8wK>wPZ5Cimm$7~b>Pxbynx35* zPrLZvnp#>XFaoyKr`s!;Pqh$dj^0Bq+%^N#sODZz@kH4>JCp} zbOE&jQWp_1F?5%hrnF46-61&{pgNFCVT=mwnx%?qO5nMIsSk`d0@@_&o&zWyv8*B@ zM>!><;Fp;(E&(nL{@bwDat608kc!&5!0ih1V|uy0Jx2?TjBc$8$IuveP*yZs7RX>e zk&ZO5rA6UOIQ&H9&%7sp#UG_CTK)9LD-@EjmJ{fji3D5>>yoN;>y%@zfr8uy)(QwQ zA?s=Bl8P}tLxxE38Y4qF+uhnt1R|p?Pi*T~M07tY69W>b3 zqBnUckzJ-d)5CLbYjnQ~tbFxSWg-CsHMDh$jyWpXicF<3u$~^rt1gk6nwni*U8gSM zm6iCIn3%Y@HVh;5?HeV*`M=ylT}d2 z{UEgl#vv6tu=QdWeW2&=_GaSd?j9fh2iO4$D*xeV{b!)`pI=g& z&pJlY96;;7mjvwrIE4gZkqhk>RX}I~S#}LX8DQHD)Qe%&fKTYoGiaa@c3f*0TE#pB z!S{N&$O|`6UdF4(1!-!!zvxy27{}d5|Q~k@L_$0!t1s zV_Zmj9Z0x;GN_K1kIQf_(|qbR1NjH@Q~-s*0o2yM24{=x!-qGK92^|*`&%L+S{dE@ zdwZDA0AjAXx;l(qVdxT-?1v8?Y;JBEfLn>R0*nbV4Qtlg>)<({F#(E&kv5oXm9;w<6#=Zxu4Fa7rybL;oLs%|XMrO9166M^!5Gny{=(3zE zj{$fc9c({<>M%;!7}qn;+)I)=p-u)b@aM?=b2l_3u-R}<{!F?4@oA2ITfr+eNSg^w&x`6!wI!{n1EQ<<0)A1$N5M7dD#yi$m8T4pg6$HDP|ryvBvrZ6h08kCu;MR$*p-5c(h2b7NTOu6&Wa)1HBUFz}rM(_+JcSp!i1L1?g7^1i^32_X5}j{UjqHBFcAMp9Crf zX7UXi-vKjA%A@w>BGsL*fEpp-WMyP-{n-=)BPf&`NU_7_z(&Fp5q*R##1WUl&$l4p z;?4W(73D>~shsf6@{FlQaKa9HaXZM<2#lx-+m6b_)3bQA$J{aE! zc(5>2l7I)awYA|?K))diYqamz8WI~DJ5XTau=sm9BfWf`SJ@{G*)JxFSm!S@Xz9e z5tdpws#`JJ7|xaheLjpjmb@6^gDn7C0qlnkKn1v6&`zPZfh?(OYip~l9A1zj1QL9R zwY4>{0<00TFlhRb=b1IssF>HTjCS-fzI2i)>o6^4Ir6Qjtz4R(=!RDE@G*o{zYm!z z_AnY4#nX@irtz=(1*9)50f0|47^m91^n@92uuBK#oH2u$T%cvjDJTFjw-3B(gshRY zv@|5$f0#IKK8OUnmamTw#w*mf{1TDU`KfyzBpa|GFf{6mfhd^Oy8yQj#!k2_OeCK> zcdnmm+C@l~otqnT1l;!4^du#JLK6*x{V>2M=afKzvYq&W9V*=e)V&3tkkBE3EEueY ziOl`^j0C6`y89B%8|`KWP5PD>TxxTsPnJI^#wcK;Pop$q${745_^CInBvhQ=_5OU>U)Zbi! zdGx^&OUp7^j1B?vZ+$}pOGGm%n+Cx(J~>uWhz?6SZ9kRlIFL!f+(>Z#b#=7|q(P7x znO4JI`H`|~{+XKMw*8~HS!vu6?*_i3uqH4#b3*8YiD|tE_Yy>kVIDt(vdYGZ{TpxZ zC$ViAULHctT95xxkp6=x@UJWK8(n}JDms=2UJyErME>+dO+ZRfmud)UyAo4X5jT5- zvHIjs$?qN zJi&Sp$qLWlHS2ll%)_*}X2d;Cz#Opvkv_ZyXH6=IavM7G$k8G$n9~Pp4JwxykSPGa zzm=E6Uf8vL1l`XVQgqr@;w7-_rzt(lTj2t7PYG{|2dn>0*H^$@P{KFku$md&tAlBn z6M;xISl@7G@%a<-iw#+~?7Q?A`S5opkzdL+S0pRBH($Y`83n2HLfE9?fB^Znc z8@TA@lCfD2Kj7P#BbouBs0V=*|ISDqW?4Zk2VEZ|0#8p*Y;i`eCWEdZeG@_%UgA#|Ykq^WYnBiEOi|^Hg zG2lQL0Ic*lsft7I^hJ6QJMXTrL0W$p6AA8$=xE@WK|m^oJB4Rs#JCYHqyKO%-gNUj_pM zZ1v20$n=lkh$t@yJZfYkMs=msi!eiFs7b977&njuWW`Grc zRF~7y$q6i@KV27LX4IeQ)-4QpMA<@`K|lYhvj(fkkPNTuujqw|$Fj1vSb=U~F1rO~ zK$I5W0PKJ#h;t0XR(&fieJLO!EDSCa!y-PR{pHVpg_00V@|p6G7HY9QE#_$`e!O;b z=sVh+w4&{h^uQ0=qw}v{#lV*$e3qu4+_~J653THNoUia%W($WgpD8(&i!um0CI}~< zvD-*wa-vrWaqIgyMtgT?)#3D9;t%rjorIB%?->9HQq$96`nk*XhZal#`TYU2`S#8Z zji9Y5d}9M7M=^&L&6eCd1tCR;+jxM*poNwJ&v_di#CK+9=4Be;abp;pY~=@#Y-nr@ zsinWazp$_n7L-h+I-RPL@%}o|2aS4G3#ZNa_WV66C*xD+$Ld73EQy76f&vHO4 z#LK%4^|0aEnxa0FdZT!QgoNC+EX9z<#aKG-7;$^$jc*?xDqFCQZgh!6 z_LBt5k&r@HcL~is>y4<&wao@fHkA!D+I6WRIQUXVccxP2rOTJ8FG<i#30XU3l<77hQkPQbylQm!(%A|I zsGjk}v?((efyLOO9ZZL-vkkcZ+}P(NXlQ7HLqZ@IKX~u}x*aR4yoM>6R2OSvxq3@> zLXRT!o%63H;9XUor`8)697%uW;9p`o|N6|OF$reO?KC$v!7PDBjtVj~Ha^~2mx^XwcPyp(NdbOj1o(-9pP2bqG5loWV`p=J9r&A`CG zSK6N*Y?=O+1XO(;Jhaw0 zi3nmGe_&vMGROyojFwBcHIexVBOO4iFZ3QQEXd~exm0Q=bd(epruLdS36F-**EJXy z5W5zRt*vqTqc-+k`>S;kp76aB;H53Cs#=+!w<^;F^S2zs=p^Lj1hfKYsnM|9NmZcq5C|rK#ctJQ*Q#Umo@4uCCYr0ZfpICjbBd diff --git a/man/figures/README-unnamed-chunk-6-1.png b/man/figures/README-unnamed-chunk-6-1.png index f0272a472be06361632a2be16a18dc3b484b80d6..2dc0b758bd658aece167e2f2a8b0f93e3e4c9e56 100644 GIT binary patch literal 7757 zcmbt(dpy+J`|tY97`G{x+@jpNpo>(LlFP@Sq9(JY6rrseQ!;kB6Z0vQBH2+Y$&6AH zNxMY3jlJ6_CF5EdOyxE%L&|lSne!Ra`F_vub^bZWisim`{XFYg&sysuY0r*@ z@>=o$fQ61b?Og!C&;fux%VN3E8CWC(av><*qEc|!)YKI1 zvH%tqfNWub{w7-_bBK~3Dv_8(q~;QnUjKeuOrD)a24u2?E}4w}6c&;TIpjhyN=GG9 zsl+5I75&Yn=5{5`&P*aEB}sa7lU|FHEkLq_H90w%oLrck%;6++#5s)(xm02)hO~uG}v1(~D;d$)J#IQJ8EY5mHxMC>9re=9Ye`F0Xr573=dliTGM9e%n^@ zZsbE9XSm@Fr#1Q#C)t97GA<-@#DyHOnA^hR4v4#Qsa<06z`(#zQ^RD4zo_f0xR5M< zoh0TYqhn$*${6K@lA~1O5}eT?6d}1kb{-4_K;f0-52_Ae9tB`&qocj8YuIgm2A-zs zcDhpLuI7_xSNUZtMhw1FXPhcdVfLf~$Jh;pZr87_Jm;V+`}Y}fz@O#98`15YE5*SN zawFbPY2K?(bl&$|~@rdkulDCx)I(fk-njCD!F$7a6)GZBEMw52WdWhlc4!P17IU#jaZA*pyorC+cEW-E}Bu=At$ z&R>r&{%2&fO#Wc5$GQC-HuYp@pz4iKJl9DMfE(E_d-!Iq*iYmLm!*WfBKx##WlGAm?ke{>#`3l z>}j4>JY3mi5Aj@)OV*^}uVYz{y=c$6C|N)iQE+uSUgIZNf4AT*_YXaJ7~(D7x@wFS zp=sHR%F@o0&u(GGG(5UkB@mvLMIxRh$dDXHX0*$igioJrP=p~0(%?BGfA9SVsmtL& z9>xkA?~;z``m+ou@317GHJGWhich&4veId#DuN*?h$EKxmnH5o0yw&*Xp_B1zUeN| zAEtm%8(HTlB^O=faCDGb$GSxMam}6}F?Q71#_b9{F_mt82^X?>VU_|RoW@#; zp?3_1t+QX^(Sc74nZX+MSjsR!&_?*BbNgr4aK5`nf#RcEOa=Ya^<5C}C^CM(PCrXb zqUg?$=>1whmd47r!@rF;is$udRjtGKX03mqNC3P87BeS6~yR;NQ+7812G0m!Ivz7W-}Nv25(Wu%q(w zRpNKw@ZU;8pB~(k!E1Xypxwl>-(VNPW2@(cVi(GyNub-0{W!zY^r)sqGU@pe%1-bG zIl)aBe#b3vXRb_bA~aL!`VipRBNnoG3#JCwWn<;`m7JBV@RUckd6uy~XYR*hNcG4G z@0jtaZE{2p3dCDacpjivhKxU`WAx2j4%C!~{pujLoX{h7zdJ=RS+67+2di7SR$bLY zul=|%aD7a(rTD$p&}x_)`p9xHV#J-0j6AW~Au$UukBZCHB|%&uGI%jJR6q-x8#*aI zM{>qTjaEoW%c_BFRPGyLx?S{1d`2m90|HDyYiyTf*OyDx=-h%O3g*9nuu}!zNCINOEaB z#s>%JgqeZZR>if7RK`a6cvXNnjhL&!jeD(gjL~>zKNRK~n{6{Z&P&vAfo}ugn#eki zu_%ahTBYX%!0Kw&3Nu{Of_CDfy)c?|U6W{KahpTB7TSTVSIFTPtAUL-MD-&T~TZb7NSuSRSDQ0pEJU}&3qxj=)c{YJEg z#57kBiAsFSx*HeaTgt?|zyi`iQL3g%4j4jN-C(U84Z^|Zbr9Mct7(!8deGim;z{+@ zk3ff{NqZKDVLO5-vGDI|MTohJJeZiaANU~;fv|5#F!sO%V%pvHEiJ$t!0wjfjhWlH z>C`v&CU2p6<8gEjcCdlXdJOadP0c9c?(5ml@a`eD94OJfbH*yoT3cnUH zsc=R2j^J-^$UE-bvA(cEkiNmx%Lh6M-NzIdpj+5gp3RA>U273z0Iv0U2QaRgr@X)< zD$N4-r|5_~^EKuL>Rg6M8X=<)+!T#zdf)DlgCVA>_=~YC1wwNP)0GBpS;@e0f)d3z zG<&bE@VCO67LCXpJk(Pe+^Rv*Y(}enxtopABm_?RHt$t7#Cl zOJtQmn!-s*eS;!8qXjs08HUz|z0#!bT?Pr;qrZ0#h62}E+C-uo30NVDY}VA^l%Tzc zyAmlcDLOEi$1nA6n_LGqS??(aY-2%aT^J6>#!dnuhqin1Os%->jA*E%qg50h>1#9f z<8PH|p)rs6wuwtFUhqUQ5^UMc(t)|upBd*h;B72inNKEIR($beFqmO*j z-B0d+bbl{~*WDo)Vc?q9*{NvNHRS7BZS}aPqgF2;Rm1;2Znqa&VZq^(GK zx@C){-_jxs-LClrqq`)-LS9e$8}@`;>F83jQ!$SM>vCrrGhU4@24E%gNY#K5vY4*% zRB0bX44Fw0=Ufn=`+M-aFm0R?>UU$&F}!DwX>_p97Hrt_CCKBt!T6#J(~yxP>g%f* z3REb=6Ku4K?vKz$m)EM12@}FKRT%%o0TyPVxx`phRV3T&0#>1QYv-_M?1@!~>fuP_ zexxJ*gY_byy<&Ko>n`XXpg!GR7N$qPGBM~&eE-MN)V171x4mE`lKu!^L;z9g+S%2= z8x%Xi=B6D_q`&Q4M$bPak89F7f}ukjYc(^C31h0T?2}C}x1CdzX&RoW?40IXHLwa% zI_!r$=C*ka=IM66S_XZ87iNW1!kkoOD@anxGI4EUzBa|hwPF$t&=gu=6_(VY91xdr z54`j(&B9d4eAJ>3IiJI@Pi+K2fF5A&R6-ZJ{^&Wo^4k+UY5L$cptbtP>kXZo)Ye;52-E*r14+6bsGRcj6yXsYGypGh~>K|(NsAr8$+_o&9d$M4kDTbSrPI3xA;FWKgO6|ccr zME!%0*MtuFsjjqV{;7sT%+03d;Z$GCKCD@kGsUFS?8~}o^2bx8Gi~c!FQYpo2T@Q5 zmp>1mFUUA1Z+Z8xL3K$+oBjz5 zeROo|z4x@2-I^>k%o$1_0 zB_*Ijhzq$%l`Wx{)^5jH+NKZ#l*SuRG%Vz6RH$`4Q~c!J&9ap_!KM5 z>skVOAiy%cC3rTm#>p;CnkLF@S>NCuLBJ#1@Frm9gIAN~F*Ou1qa!}QE3Pjqi^*7F zu*o@tvkJcK5d_y+hkYOFDEB;H{J0H9fp-_08;@@Jo`@b-F766~jc*UUO&7oXqx?@P z*bxOiKW+%n`y59Cs3j9$AR{73)g~!sg4Fv})J0$+ZWPVWseAcY;wf3&tdCo0v+;ta zi-%+0)~28dN16UXPaE=Bx*v>rPe>zIuNAR7Uz>W_(EF@ydFvxCE&>!4N?H zHW)hR8}}H@30OV`E-9czc(nihnzQ#8$6k^OIw}(tIDP(zA{sa20YK|v+@r&tjO!G?d8!^CVSnA5~j<znM`+L^}c2V(Yo z;R3VwiEc8y!w~zUs4p=eTjOjryVEy|rk>x-dLK4>B+fx~+kO*up=5DRZv)2+RcE(D zs(7Y#_uGV-+IvS?&Fe2D%Nk8M1_HC|r{M(kThTs=TVrAPrWD*cT>>_h>d%&Ged7{9 zR1x{{y8K#K{nSVkxmi}H#nN=;@lHrmYp$A*LAUur+GxtQ+3({Mp`d2hoL+npI{DH# z_qL9A>CGT{G&thUrExy>P#?C5Am5mD-_L?b8V^kZSz#2P>scWy9n9bvHPn( zV-}TyX*Y1$^w$tHk6f$J52?B_hg`w*1EiR2sWCs}0p#-&-&WxOvi%p8FH%UhlvIL} z@NT!kvu}?iq7|~F{s=))(vSe~y$-r;J}+(p)Ow%zJSqRdZl z@ucf$9_{N3+*v}?)YCV^7Tg%I{H3fG{W`m!x@gC|Ev)|}Us=&`Z@GwR-D!s&cV|uI zLPo>$oVjvFz3AeSRO@_EGg!qK3r+b4EfeQDg5mVxYSV&wN46syhYV&b%Z4FuJn8V8 zPxEl(!X;-{0>MZ*c`<0k6kGh&Z(h|BNf74!ngqkq>tnfxJ#yl>^=nfY-^=q<|JYS2e?Zmx`a{d1)b zFRW;uS5H@pQWlrA{3juehD6|3s{9lvUJv^jo9Q>LpA3}nWMSDV;$&Uhd70Xfg$HkA zTc)D~XHO);gSVIvi9fJb-7ZjDTXJDJEHxU`4FyRtqHy=jpJ?A1dV$tfWi&U$9luE< zm{8l;t!MvpISxw~v=FY`id7)YtNb2ZR&O;JJ#ND|5Hn|l4(u$n6TQZ?a_#@paGt$^ zj0Aa$T2C@|^n3!pI4Q7CGEnAMRx#QGb$;4!jT$ogdIv=&>t`04klN|a%Wsbz*PmaN zCiGf$_vKA9lSeKx(|`Mk@ifF=SpYX}Y&~!01AT&4k068%$KKaDi$nLdVW&PW_5Qd` zKW!uHfK}vp^`W=jEiSthM*@s*Ef-aM2o|qt?D%3ZL_df(PGj`E{$%H`F*aHshU*%( zy*Ny7-$#+5oPZnmQT%Nl+ENrKP#@X$79Ks{zksxi3-p5emIc{8#5ZRLUex-&|H0Kw zlu+eX=+;tFb#hUxPPkk!-TlNTmsS~$jm}EiDd1WnrocOtZuO@~OkaTth!pGIG;MT4{l?c_#uvT96v(z8 z8XC&7Zz39jV;@BjddrI;nKPEyr|m*7tWtlUmf2Y%t^l5~2J!b3?sFoMXpOl5<@ZT+^!S9X9L0&3uS00GzD0Pp zb`_4kmXo=bFN(pADit4C>$G!C>bea4USJV1y%)VbH=`RqxV9l+^%?cp)~Kn3;;bxr z*q3i(S#h3yLS>UbyrkNW_Hd+MVAkvKWTp}#@kOd|Ai+(Ikc;SOHi80=vzhy=WUixA zmciH9i+(%O@5eUCntY-CVf=w(iTDOkBlyK{4(;&^)X_aa=7?4tpLl?AcW5fGpv1A` z5wdtW$apShf?&cf`^yjWZ2gW{>(HmfauOxh!7(UD8G5+NTdIC9p1C1+-x8O`@D|G$z#`2S|cfJRd%B{@e*ZWL+3|NRdgw5Dpfd8`>h%j6 z_Q_FP(d*tv!d0k?d+;ttb{BI}_eLy@G?vVFmjCQ^;kuKOl~tb0t>s#AzX1zBnmb}m zP_e(PJ^6BfoR8it*@D9n%2sc@Pe-42aoD8)AvH54(36m=HyeXCTVWeU;pJPZr0P22 ziLb)g-o`J2&c+9#uYegsi$I`Q^<=@FZ|R-bw}%>rbd?TQ+^})nQ92Rl8UIvO^0Xm? zTYQce9-zCaz1HlWFQXGE0481Ta6ZL;?Oard=h_(H|Hpld&z8Thn zY=*qlsBj|mgGn?Vj+5e@NF>5L?zXBO7>v65m^Bq1HFhBrV%`AS@d6Oc=to+{j_SA$ zW%N8Q4|`cI68!$XU2?aCNY|VTd~c|cM$AU;bBTMO>ass%sw3|H4BK}fGfk1e!xN!w zXyJ1i675tYa1TMRan>QBhZVc2VMdQ^B_Y3Gez9D~B4f29WYxq+GCKYSI ziEJyH5EoX7HIi~z1mf)R2q6mx>(@(Osp25_vdNv{+J?l{Pak`3cevaz__irny*^J5 z&eixmI_ld+0-W$@AT6aO%WQgMaE8OEku19g_bpm5$yE(u6I;f1O|AOvdeqJ0nq>l2 zDGGm4mW4U-PO#92dE)3Zlf7>4_C@DFo@eaAP4uz1j=6u~|ZTjw~9bVOj8{PZ_pRT`}d0fn_X zawN@ss5j7R+E%dmk`ZXluQ|o`Fe8Q3)Af^jj9{fk4C{aUlVDr_|#WM>qW575?+21&R;6QH7bpgwq0 z`FF%Tf7tfMxP&5%rh-4utCaxykLnr?r$z{2f|qYDR+0*XPzIfHqBqrENA0r`Fd48;RnnBf0EKJwpM z;-CbIwn(S%K??-+Z;@$U<&wbp{Kk%*ys#L6>a|X#4k<3~3eTbHy5h;hc=eO^1CxrQ zKf@z?Z*lnj`HfAcRyJcouz)}nZVh)YM9REruM_r37$-cL3OQnnRcgxKy#tV z%8ez-55$co7*u|goFDG^oswDrJYrCtZ%jt09TPw|99D_;mKET|kH#U43Xm)*2tEfc z9pq3D|9^dqErM8ETvXN4LXF9IXQ;8hX2;XZ>o7yJ*+jN5tzxNiwZZ7?%Ts@|@H-`b zG0qTgFK3>f!}0V*{r2|u>}zgU_jRzqcZpssjO%NjZ!fPhs6>3rtE+sP;Sj)m%KQ;T zr|JbB?ciP=oP>Db4(OxeF7)#r|J%c>%v^<*W&Kir2{UlJqo*g*5t6Ug()~!yhnVMP z`qzb%+e(wYYD5-^I?KI|C&EGd4-bcHB3DVo^H}=*_Jp7M%{XS*VDC`B36^pw8MGj-V zRWu$!qpRIf8U7c$L%7$&l8Qd;NXJlMO0Qsws}HX`30iFj`6&^+d{*lnksjAM*5+uy zmrNUanpDk!L>>)qQ)|z=?8U_qO7G{vEBN!(hqjy?-Hzzf(^G3>`1k+)4Q%ar3VX%d z)bq1jWdE1{Y|s7EX>)~V_SsAJ0{5^`Q7iq(NFzWmcs+ZIavSs7Io z7?$|ERFDwQ*Y-7?P;%JRRL3xxUwv`k60M&3$pVu)+^c9iY{j;*N&J}MNhm#A5{NIt zv;)BC96h$jMhf_XaDzO;*zox1aAZ*8Jl#QqAIPx9c|LMbT8VAqi1HO7zY9ooCxqwV zGW83Gx|6^keNJ?g$WgUl0ku)sr*uWSTZK<-QI2lM!-QXW?&#_xp zayk9QKX8?2m;?v3#R{-Va`6T-vE851eY0N`kOj7rz9sf}Uh=DGS9R#6e}=P-u|XIE^nPVHmQCcK@p@0`~W!TqXNb6Y}y6zlbedMSFY+uvV-oGMp?j z)s4(8BuCdVi+yt8lu%m82Gayx%mxddgMU|M4+vxx&BC#6Y4%*S21no;a={^)YRe)i zM498pot-oQg?fdFtqYIHvk6l{nwS{Gs-5MZ7!iIkPNGA4IpG3kvlS%@RsO>i2}Tbl z{*6YWx2fmz*UKpw4(j8VDEKZ)QbhDhS{AO0&zNbOMju3@$)kxYp-v_KSoyF%J-8Pa zdZfPa{I)=}PeQI=7^uYM#N_QaNfq=I@%!fu2}|htd?7|&WiXmdThW4^{{>J)d}KK1 zq7nGc+fkypczE=f!@^h^cDtj5!@zxJ^N5Q{ktCR8zPiz*v9C33 z!t%l}KTbed*j%q4f9MpGg@8kD)C$qNJ2GM=GG(NX@Dhvf_p8ZS?4A$!tb)6LyUSl;%#?|^RwuW9apy&c824O#qklaQ}a9`@#`H`}uQG zaj}WHIl+wAT){ZkZQ_=*cr1G5{(h@Q{zs^Zf5<~3ZA7FZVnT54&uim8q`8wqNEA7A zXupFCvqXN94xyucN3Jx2ROpsOu4*IyaWYRJ2&azvn}xsj2V7c5AU1rQfNKqm5~Qg{euTwPsl zZLgHtA7`d*ei)OZi}S{l8~2nu-j=|U@o2+igYKT*{Di?Q)>ZI>r_;71?#yw<5V*+y zjQ;dJ(`~YouCTVO86j1@U@-gr@!~|iian?nDk~NK%oWRVrqFXWK+VQgz)rvt{pf|z zSS}qcNvtPKlyM01-H3cQv4zuAkVF&U2zQ~al|Mx~*Z(9KTm6_{FB96` z%zB(E=3FO)vGNE#ABMHsZf4a)w@)NPjOQsb`87ENv<+}S3aSk7IW>+UWuTo-eot#^ z|Akt2(CoN>cKg}7i=$pvvxsrB_F!}q_p_x#Ze!CM;&5I2I8m{9QkT9mU7#)vO8rfdGF|+IMVCCY4)3^vLhI|}QTufsW18ctGcPai+l|(n{YmXyxk@z* z2}Wq|s>@NCe5LVJeq4Nf!~plJ>6>Ujp{?JRGhdWsnAm6xdjCb3+)%zcyFVYU<&3M^ z&8p(cnuu%j4c~SA+S3tM4&$&&PVS9tf}Ms^t?^45+{coD=d@_1&zLXsFZ`Sl)tEX)sw z+%h0B;gBp-u65_fnp#!S?o7A|okbFN!Sk^eYb39sAu8zwZsl-{!y+BHRFt^>G zS<@K@%PzSK7H?;vEnC|4SmF^OIw-n>N)E5n3{-18=r0+n>%L8qBtsO0FI24 zV+8Px-tBg6O$~KOmCMZ`o<)QA)+AEN2uTsW6eR<~0?Y zOY1%rY{VWUxh8>ep~CkGvELC*|Kd_3&}`IPXB%exF*9mQk}UbU>}yE+j6AZ~fH`eZ zz9jWGZ|I83VsQ8n`4Gc7H1mStI?$ej2da2*Mb9njUG->FS^Iup*N8Da^e}omLkp3JX@@IY<{#!J?tvggYFiotKDkh zG57vVT=Vr(DqP)=n^cIgWO|q3-!P4Ally`=4DdAgyxYf%NH+=VoPF7<+q9z9;n-N( zqUeM_57E3yGoBoH7%{J{FFy#!l@QkQU^N= zeN02gnhf!fsn}6y^$7VB9&f0}hC)!0vwgW+=ZJImI4vta`mKB@cl|-!R7_|*PH*1U ziWLYn(Bb9SsIFO2|At-yX`up>Q|@J}ZsN$)EL+j4@-a4g;~)ihuYCoV&Y@_IUNx!u zp0zD2qGH9;<*`DVMfy+2Y)q|8=_6k4@sepF!7yRGmZLnP}su)8jPu4GvzY8}1@i8oU+MiT2~X zhX6!=^7TGuB1+y7YJ`btwN@-Xm@eR$U$0XC&^{zS{!_3h3sJj zyp(}gnAG+6)y}4-CK$TG__qU^^K+gI{FkU>>Kz=s3@wu(ju9w^6~9y819@zwI9d|? zJPZ;8ridyT1NmM!+aT=Nqjrs0G+*=;u~w{E>PS{Uunyb-Q3mD2em|=8V~;q^8K)Uo z5L)M4XfL=E&6g_Rn_c>xaQ0Oy16X67HEK#odJAThk$nOq=rXTSgw${xmX8@Hx$@y( zm(u7=!47lR*b{hPfd@$0a~$AHOuWTH#U%0WsI}v`THqYvTT1DyfQ=MZ8Or5 z$%?)hkzAj2?_vAScZ>Z+(||Jg;zKpDAKb5zfF5ROGU-gr;9x%*s6m!E<}be~5k~wH zdt?!H&~;dJ5QHiFU?Sqj$uzp)Kgxc}rcwU7(IAPAkiis{m=tP@E(|9tX_sz@jmMMW z;)bx~G$eZdf`fE+EurB}BjD&VnlgUQs%e-(R__?nTo={Wwmlg)s9=hn;Osi{*$RrE z6*$+J_??lJBZ&8XeSIYrZB31hoHy67?B!}aQ!&ZeMq%~69n>TGBkY`U<49S2ngvGp zs39cy=#y`;ra{7uTXO$8=tev*Weewj@-t+j$0zTkkzj7xhk=FZdVcx+48sg0%9TAltJRM(?YUw3%Nk`qDzKu2!&C|w}mE%bOc`x8HEDv$fY8qQf2DEs{RSBteDbBeA1E>ECtq~l<3h3 zPNug`;XSZ>AQz|F?iqc?u=B0B)qnc1W6khy_wk7xad}S^F|RB|tRq9chR(T9HQw0$ zm}ET=27;ds?w&b53L>NG;-9x}ByjI*C**4^PEdd>YY(Xa8SX!8Rua)@OtOvb8XjTV z?IItrT%&e{GTtY=sA=OEm*FHP`rj#N_1mIJpK&XNx_6C)#3%uxxBkvx+UY?PL}Y#` z8Q;~;D6>_U|5e-^LOSv6pr4ZXb}5s3M1xX?Ky<=_5VD!zp8k1gzzsq7!+*3g`21I| z9`Zd2lb=rVG-ki1LP)U#SyU)8Gzlg~a?|#T#^hA*Eh z)Cc+~I0MO#!j=x@>{Jz0RO}>!-R(Q@cEZc9T*Dv5mNuNuC)H2+H$zkL*7BeU;W@I3S9{ZAo@^ip*V_|M`Or!>l&^W94RMwn zJiHe@#F^V=92DWj-(0}mzodVJND}s)%~dq3VCI*NiFgL9A8%S*o0voO!3xS)r`_s-Gs+i@M zt|6;V9=XQY3=LtPkYWSZ=Bp+y+m^IMW=m-gQ)_WY3%-|YrK2Um#;2y?E%K_tn~b+p zx|iEPn7t#}InB&bHCEgujw<5+m*)WM6~1+3!0FEuIo@ZVo?0ogeuj7RNxoxOer-&9 zGmP!k=<&c!YWB(CCcu(NR-B&QG&Zif@sG})R@Su7ZMmFUjl-JDJ-kiI@-w!beeoab z<7XS8;h8QjZx&18pZG%fzgP(k_54rHQ;@);jW>2>BB2b&MyLw z-0)IjY)8gcH;@d2+T4uV%#_)wEz3=Ht02sIXkfM6_#`XUWeG8`itxpKZ}aL_bSAW7 zI)4xXvJ-EL;gQ6b3E0qgYl|l?LkuO@P^O=nXz(Q6aAR@jQIV7 zRi(v;^F&|u5z_b21j*VU^;o2Ovxa0~pq}L+Aoy#hGyaqx!7+zLsf6vRx$@jvgvq*U zS#U5FkXAnb&^K=DnZvfPI7(Uja!WixzQcHU9s46#=pm}fC!&t8`Ad1~v?a0#wZuWS z*oBq0bezlX_XW>54C|X&k(|=#B>J4z%7Xvl=Kv?_oeht$&z1f>h7F^gRi!Ax@~*mL zn4U#yX|8$Bo#>4N!_O6mXO`K`PMtKEbeFqWJ5J5{Gc!XbEputM(JyDEawFy__dcJd zW@_8V9@HW^oj0D!L}tQ*ojrMgu>np%L-6+zuNS8GmSrUB5S=D=4zi?$ePIEIXn~4+GwG>F zyC}+!s~Ytl`}WYXy&%(+ zu|VZiQMk9?b7Tbz!OseJ|68CVk{Ry4=v^yy!?+>z4N!_oq!N%;u)`v#`8;s?90=O( zn3e0KRNm>E>we3PpZwz7BU4gR>o2(464Ruixf#Rot8hiDQjGgfWv+T!t6&I+BoW+a9cC3o7PJ*9W$QUK)q5*cee0;uXK&opT*OmS`|*Y++08gZwmqKz zgzYA5s@`+p=rJOX)Q@Tm;qn9<)$gTezmo`ldpZrz4PGNZgZiiAb-w$oPItf& ze*%1E7})2s3S*w?a4`jKJ=t754o+>7?~+uN9{Pn5Gt;`hd>6_#P=r5z^|5cKgP4;~1iJeOqt)$2zNpLWe^1494`oXiv(gi)4RH>|KR^mMr;Dk(akw&9vR0`{i zA%D__ei<&v0X)P06FsXS<;qn5Q42F`vV~sB1~)v;D`C>05Q&Q4LoC8S?k4LCj#RB&EFu(OH0- zi8!PwjPyQ7`9^L;3`_)twItaEIdD-Yi-JNaB2Olcg5tcLqXQc#6sk;;Qw)i_H_hiD ztZH_j&G=}zSSn2tv62==V`gK7oa%5^jHv$Z3HGxl_jwddT?<5~>4H)*512C6 z+e2}eRiDXAjyQNt%wa7t7je*q5`9&2FAkX1=&JBAN}w;8yW21>xN8dJSF&WPDl-=F ziB_s^)7G!_WN?M)Y$Cxj1p(gKoxiJ?)6Uf{z^UmR_>y)RnnN zn-n|k1w&4~$_ZEWvC&U%+?X^?dM|L5b^L+N?>KoLDTbj90&;XpUd_!T5)Yzm7+XD@ z2jS@ho(Xuj04v{$hB2jMHdxG0gyhPunrr7_uVX)Wp3a&Psv)z?hm{^=HeKA*W7yg0 zS%Wp&ZQVCuYS!B^->iiAi+=%DqFo%5&zc1YSIF&=%eq0-T&5fk~>~R-)5{swTv#W!dnGnw3w)ElEaGexrWK+8{6c8 zybqb;$BMP-dP7q^EgxfH!CUm<>$vzvOu86NqBR>oJ9`q9$>9Q7!^gr?iA2Y`(cegn z^oxcuWX)lVT9j{^VK$m83JPFp3r%;2Yx2I-iZlB1qtCo%PZl}mUb9|3O(%6v9*qB6ePfjbELh>^1LOpYpq3bqC#HmsLR&@!T z-I8h|=&vK{>B(;ui?VD4ak=Cndt<|;V*RUU1uE(Wmg|-SKl?=7~S4zri_$Z#;xvxD@ZLP#Y@PI z2%qfVeO0{!S=V1-B(QqaJ!6S7%3`Hrcyk`Tksx52aBz|AzR+Rs8-)G0zxw?nRNDZ( zg1*0EY%yjq+bu$~YF>b5Cml;cu#TS|=@`3$=BBba)h;AerPrl*0o(^DmvuWUN%lS@(YOumA6cyHg)jR9c0i}&$oEf{ea+>KJaNU zL#?UnTY2lP^Ian)3t#ur|Io8!kgv6Knok#zp3glWWuSaJov(JS@c}aq#5Y+NJdEOU zJcN7j^n;U1@kMzIWnVkajG|JWeS~#T{7Lg+Fxsb{ZqvOTE;TZ@sG*Gr_aY`P zbg>g`2ttqzhc|5XrFUcRsJOcq=VjIRFo<4~vjmnn1zRlqsaUDwUfr|m4`{|dlYeX? zJ8ij-PMh7ss~rnXD-pTyM@oB>+q;Yr#Ukn`gb@qNdsz%BYX+hnt!yN^sZaT!l%Y{ z%QodZaC1|_X$*GH>sLi#sKv8nt%L=WO4Pynx#ud+odVoXkD?P}KBQ9MKqI`q0TNMM zK?MolORa4~MU_3w&@CoZ7mt|BH7tgT4wb&TJW>SlcjZPJJ z@!Iebw6-PxI7A_VGWJ+@H44jw3@6S&TrV{Hht7m``^VD+ar-+!! zKs9^RJ#HNci5t-QbbCgTweIzULoxy5q<(ngux`P2oY(1|m zS0jTqeR#VduF;~Z?8?@D-K;>rvU+kWzzyZA#m!y8Cz79b)V@ze;3>t@u!RO3Zah0|nNCwyoMcXOfLAIb5SdkNi2qHU){LpmT@GnSrF`3GjGMz2OIm7fWg4V4mrt?@z67c>m zqojuCmT_HB5{uxeVB?w;dv~;&z@M5B%0YU%77ByRkPCO%)%61Gyrto%z=4xXEHcuz zm0!Ocw$J~b@#SQyP@GD*w4Gm-Q$e~o`PCzXn1aK)#T;^&(J@K@ z6mf-V!Rf;$dYC<8J2nGv+1<6)resR3!f3lJkK~Y$m zp1z)xVC>bYv>oSlJebUb3n=D=XOcf*9_PJVo@=|U)s>km*Ld2Fk@*p=SF8Hs@mBD7 zlZEuMmFcXTCU-hJmV&m`n6pNihQoh)KO7kKQZHs2e{7L+YSwDfw{CF;+qx6(o!txl zWLwr6Ns+#mdFFKRuj;;QIPg@KXl`2yIrQs6W5Jb2wfQWW@aDPgR5%=Vv4asn!C&pd zMdoPFSLr^Daap*W=0y3$y_y&zB>uCw}**llrBlC7CiBp9$#d zY%O(M3;1)!ldq;kj?G)lcQ4OJ@hS#<(Qck|$LgCWn@wCW?QSB{x^)Zf1-2rrMQ$oh zHGYkj^s6x|cG_0rmWF#9FR+`H*n(nc(>jeRa*VaOC2^;MkX*{Jg>_Wirj@^}keYj{jxw~6mPHKi0dq!XI)3tcC$-R2UFN(loq7Vr6bzHsi6fn|o%qRTCzm3C;PEENF z%^1F@t$Ev0_MXddb~tLr`xWWh%8UAXzM8ql2(OwXC;HK_`6gPlrNXVR4-!O~2b^#H z;do?aIb~%IK*Ql2rn{bs+pm0s`-F+fcfanN%`q)jNmaxu(d?{19Zk%5%N>DLd9LNp z?%Z>{hT-5>3pcmOdhhQ*p?+Y(xp{XjLSVYRQ$T_6wxmEG5J8x5w$^I+?V;%f7A&am z4*@|je)Q7!@zv8m%zF<27!d=o5Lo_ufwuyntPHZtg31W#-f()knPazDzF#!0Fkh(J zDXkvEElLi>f0UvXoFI43((02CdbZvO=MrfzM##R6?<89$@uSh8m(Humw{@8Wzm7Uc zMP{}Vx-r)dnbo3Dn^i7=1zWz+ZmVi)kdWKF?mqQ*;6i|YX#)5eov$iMh zwTCe^%U1iXaP|nt&~Lk)*yHKEPc>80Us6WN)NG@^w>#@oCzDs4vEvb~Wku8Kt^9IY zL1VZ#Gfw5V0~31a34^+&2Zm+MVNf>_6u>tgMILVr(-#-;B&42BB;=;l^rAbBo z={|qIeKdWtaI4viBll0I26=7it?GS&BMI!TbbGj*lHqU7%p|UbGKj&$lw|u-^HGY; z7NL{{a3R(#nV@xYNuTz;-P+dCnchn4hSRnsp1DTHaL#GGr}X(I)*0jddw2{t(g*5r zx6Tjpr)&`sX$>Ur?yf_k8?LVvwBA0&}q@ zni(iFEsS7q1u}jB-Nz1TEPlEo8$YhoOWLoB&e7Q9&#-q$TfAkjsV_{YJs!;~_hvuC zTx{i?D1}`4Wby0VbUE)$#wELHFPwrCi(a$Q=3*$$c&(6i$+d_3Ze;$Z{kF|YVKynJ zNfzWa5)G&Yhygf>keTX&UVgJ^)8@$A^=`Pg_7+pb+|;%Bn?tEU*t-(@G3u|tp9yf)xtZPM_=HkQTqTIkOaV9VewZ6B3Kv{tDJf! zh=jZf`QQst=()R#zF#V7>T1L532>==U!KGqduBdayN|tcMr0X&mqEQD#Ew(LwKvhs z_c*Oz#S+z}1%Yr7J`j3M_@Fhp{LURHYPasdSB&(S3+YL%Xqan1Lz;szjVea*P{>+2 zVuMDtQ?RjlHSZL*Oisp~X(Cw_{>-#vf?VyZ)K0KyuWU{bM-KtgBZhMViJ-~MCnVg6 zg=@~A&C|2@O6EOuq zE;!J@j#d7(a4B8Rd#RqqmmqwZbRTn8{FHImf6SIs;%w#Yb8x);_;Xn`gZj6l4K}iVWZ#pD3G%mYEwipr&lp-IBR&X8Y_mxz<3oLU3#1U4I-oc z_F1#v_D~I%YlA66y^f6E+Q?!1vfvpH2?lcL1JewEqh!iwNF^9$!8ya{bIH~uepa$! zDF51zYKNMN$(GkOGxSl{QD@Ba9?QXYqW;F5syNA@@kb4=v~9K3#nVQztO-Ae_}91h zVW7IoRk1H_t-lh8%1mcO)!H$PdMFm>nDA&gw=T~t5{@8am9{nwKU6(Bpr>hXazr$g z{{DhE7OHt;r`^48{sBZx_CC%maNMJHZhS>JuP@FW>Yd6D&}&iMmZstv?HvXLZ47l@ z={q?+&|S}Zls1#Nn>pGFh+Q7}UGMzE_6utWL4Qby*CDWBvBrawq3SB7#d*_yf98*g zYb#|fy7;%=l}0Z`#CsK2@VXbze+pM|RMQ$YKOk)toW`X=(dRMJkiEZ90mUA<30MV6 z9zeYNyy^ai?g^#5bdj7*H11l^wXzA!^S?kcR@UPix4eYD)jix$B^PISK3ldQHN9!m zqR3AzUf-aTbM@lqSZiL>G>{N_eMSK|f5F_&#LUg#Sfm+jicJz*u&v&?`z&#AE$aG+ z<@%Cj_{3kvIn8BTf8ny}$KEw@yc}&*8-30SEta;(_9GlX;<&vlm6YKl7={dmcGoEooQg zMkhyv0>Rk}oD>r#5kGW{H0`hd71k1fn1E;yk|`ZdBw-}{R;WSVk~{q)f8gF(touqa zqr!R^;@FWEU%_9Y&z!E_b*sg;miq@!gI`KUyF}A+O%1NA=6uvdT|WZI(~s}Ol(ML$ z0Fmr^P$?cZNln``dh^)Z7rSd>kA=e-t*6yA=-yt;6!VFY9mltE8Fj^`LF?7kCvFiD2Mgnx#k{dcB^iR$JXmcLA1_$#XAM?vTmZ7^08c_rGg}g#wA90pfhk$W z>-yr4%70PM-+FO)_qtaAjICcj%fP$mv#tU&wKmHysYYVIx7~mDTXJW;tF@9$x1Ivz z1rPbo`~=;v(zLQAYPr*97g!0JI{Eh}>ti+kSLS@x;I(A?g_#uY%am6A^SoFx|khzVeZJN*7yh=ft?`- z;YU!ygPl?|YN!hBZYCHEacoi(tv>)LfCngm?=C>=qghnxM|roO6+2(lfW3! z^;je1Phq_#FT06{s0_akuf6_W5iIk>{lDc!rz>hUfMX=@9FtAeEa&>9E0N;^W--Ll z!n|k^P3{WdY9Q|`onG+xlkwVn+t?ibotKWI0jWBXGkBb=EUxlO3)!9Nundr1CO~>6 zG4Ow5jYZVL+|Lq6f}4uh-Man-SUu8S^o~iVPmNyVCPg^{Rq{uX_!9D#rR+~;`^S=M z0NghCeSYr|dNGXoo3d~gK>+9bvf1_=ejPM4DG3_?oin{4tE+0`taJe54lCuzh;Q3y zt5cguZe``ry2$rm)04kXPmG;aJEaTc1*8g<(C8M?Yv@p*V9B0yz0 zdGQZ3czx&@L{(F(oWDT%&Emf)k`I`2KJgr=jWy-fprhbf0wsB4Vq$n?o8kFtC>(%eaklYLkblUj^M;XMBH2tVVM>~K-W(1<2`nH=g0J}ZDcHhTNE{@wd1d%8=mPU9L(AcNx zt!kb?HH>1_#y}QZrzfsxSS{~dmMssX+ucqblpY*$AO`c6_Vz#(M0Ie5f3bJ&Vrk0lcHroT1o=<85;4vVWG%at0 z0YIuDA~`^4sa`yv%4usblE^G)=@Lc^2S*|-E7Gzn{v8YzW_{@U!S{kE5*)3cly@@D zMmRe@y!TL=KioKjfC-y$-QbcO7N=nH%H0(qJXz{pVtZxvk|o&4 zi^je6GM{g1GsabW3+K~et^PiyHGbgxn3Js4kRZQ5#BgEEf|+M?*f^DECYF|rf`#Sf zr}gbG=F}LEov0pvQc_%R7Yxb#vM2Vn0GOhDC9nVk0F+O5lMk6FnJ-)HY~z)&`&+8e zy{Gq6VKJsTFX`B4%yNf}8*+D@6qkJ-wd9KN>*dvebRP*WMo(pD)9&zwTa5mKPGznG%QscZn9oU)hfRE|$Vr*x;#I0;-rux=qIH@q15e$| ztE_Hmsov>MV+A{rIr% zDF$v1bqLTR5pOU}-~~p9>a?hb^%dx5>T9O|D1V5g@;{;bVe>`N$H!(IUNG8vQo|Dn zCocA(J>(Avto;(3ur+lx6rszj;0$}k^=10L^iES`N4D%H4U_TE^3n(b!W~86u=t@N zItdOW8KysMhBEf)RE~{}A>*;pX*Aj8(!gpDapkbA5^gp>-aG3X%8Tqc<{UIHHcEEV z;inQbnYCNzCZHTzGKvqFC8cxduvEQGKvegCV4?`qGYkZvfSo3_nw~E=Zx0!7jX)Lw zNW<7d(E=7DSt-#fDg00|cz0V9^X9l;GXqUrZF1`rA;#Gu=NvNGfU0A_X79-aTYB0) zNwjeg(8s^YT{Xm`uTLyJU7={9K;SUxil15wrYJoP)wW76i-m9B%36C`^sENe12fJh z#xFD~Ip6$4AHG7)${EK0TO?0fj6H9WE@RiS3Kzcu@MbU;N+9iQHN{ez4=YoY;(1@j z5jg57Q3_6A2W(w}|HXgQS`y=4RKD}79WnXtqwKwiueyM@Vz2wp4AgP|Zt=1|a?}+| z^8TY2iE<<1=l+HcEAwxLft#u@`Z)T2lKwHX`WjnSRMFp)sMp25zpx$$#B>U{Spy*2 z;VpcFuLPUNo1Z9(?*&+2psG+z=LdaCo)g+D&J27Ff(lfm`IaSO9cHxR^{l$dK{5D% z*~aOhtD>L?ZY795WZ>YBRrBTQmM2h0B9qUr8G0P@%KC~88F^XM?awr}x1}-rN;pSmwD8aPk(#d`cDL6?D>7vzt~! z0%0ownqLp5U@$QyV}6Q3Wq6PAtlBJsNK#D_qZWOUrTr|M-UXS!E`D`jh~=*CP|h%t z(eXM3cu?m3!LXT67k_^o>O>&chM=GuPfkTX9#=Y&sEXILxcgEj?Pb9E{Ufdz-^(rN7FlxmoM{?3ky`hKhtde9gfYBysfd8(-^IraZK3Ka zo0f3+&ZYI*FxebnLI_|&NtSk|-%&M8sRDE9?dU~cl#bK63r%IEXv^?j8ic9P;mI;9^X@Uj&Ewb`=0%@TJ zn`sicE47ofoK+oA2M1uvh`USae&KXI&7>mc2;0wRIGo}HT-cQ}sA*KOFEIaQ9#_S;mWPzLrL#^gn+hISLH!HXiO-i7$5QuGx1cLgAA*8xfqg z5>KVp6zE2&^4?-S=W@5*d#O=*nK64Ki`3)0q)HfCB*(~3hpCI;Rw zNq@3O!X1A~zAfNlmjGI$593`Tjh%}YakopB4b|+ccwMN?aSR>&bd!0TN`q03B@H>$ zp?Oz>=BL-cMtbN1d;T8Eh1L9vVG1=PO0T2bp3h>h^7fr1_4`RpWvbXxN8{4zpsQ`@ zx@$%Hl_618HkTu7tI~)Wq-_ScGJm3=y5ccPYF8!~mRmsL(+3*9!#@S{qbO4ptN8i; z7Puc8G@>sHB>rtA~^KOp}sRMCqxs+o#Z8wkgxU0iq1URqFAG4Qdl4@KZ5#xH8XZ3(s^ zevzMo<~;!=%D>Oy1Z+WhVS|W+%ZXC+723pi<(VREG#q=d4k=-PqdV(2UC4rU!Kw)>)C0gs?NsR`;( z2AVOnSvbmsW{_HxxeMa23V0>f;?$UU>q>~*F8@xE0g-Sc zu$Dw5n^KV?39@~=zMoP&Qd*CHM;)YVWOL(N(Ow!pVao>EIxyY@!`|9=Td{*A34w)3 zq64c>&(#%Z(3^uFo1~Ra)3MZQFzT>5v}$^uXpkd9=I)|-rUWsGcO>9=iR)Mh$Zap+ zpR}lMM*d|rJZNo%PVbRcGBb{}Uj74=@BFcCLs#Ikx_RHlMf?N6dU3(+`DGtJ5iAlv z{*Zi5iM694K1O9KSyy{Hhh+qD!4P8?o{9eYvs1tHYk-<}k_aV2J~Dq-ov$Z8QE~Yp z=KVPqK$aTG39=&>1cXZ4vb&S&201^t_lWl*CwkUDthRhe z&@_)2jm+5+DKkVVpoq`?ky9R82H{bglmEf1oMU0z;}Fw>^n$I1Fd*8fXBp~l z`Vzqduh$VT@UqxbZ%}gWf?F#gS<5!V^ha|QK&awrQK<~n;-FRH85`DpfMW7fKf?2| zA%FAR>yzhAiB_3r>*I>!TI)&Ol8|i6%k2`H;2qG)dggK0EK2CS4P???Umy0K+7IX2 zUvGep%%^|fQOlGov#YDGZUK1tMgSgAdT5+j#lJ8A0OX(b3{u^@o(&g0Yhs08@Zop*^5{ucoQ_x&jcoY&$O1I>Z!4 z1fV(J``obF?|UyVFBM7@c>!S<=YMl^bi6aN9OJ<6q(V35y7Lgh-U331$#o9tDOQcS zKt?WqikQJc>-(=2UUO5Q^?!TfoUs2Z+_+#NdcD@c*b~9H4Fgv;Gc2je8 zsXtq=-`qc<~{XLNVed@U6V&oy-HiyZbi z97sORX`Or(inc`T8nw};X*z8>Lc!-azp3zi=|W_rqoX@+r?Gb@vFBOPGU@0Kd~qM~iXs^M!5J{^`Ob{Id4;q9r3U?vJI(q0QNM@4EK1%II+s%Kvg8 z0|ah>TG;PK<#z+ZUZBx|WbO5~p2%t4`|;7m@1N^g>)riUWPxVy)$_YxKdrsJ0Pc}#%hAq9>-ToxxNHKB1T(&~)W+OHIn0g2_;{W&W0$6bvK0TVKe>Kl~ zh=QsVi^&rG0LloV8?K@&(6|BQS!wPDAg#W&b!F>f`TgCBgPO?oa?6@Xe9p|dY2Wm5-j$AtIgZ{dI^_DQgy9SFlMfs$*H!mrRXui z_ooS~cF&dq4x`zn1C=}E>r}9OkEbK|CTE^n%^WR%_hXKgFrc{>kOja{%`1d(P?^Ax z@10s{$IJiSa*kvl@|u^R>9U^{h{>StWHxxbP>qK>sXhq_lKh4k`n8#F3nY!S8Y&Yq zY1}kSb$o)v{lr+n2HUBQmY=-Ojg+tfF`)My+D%DGNkBm0jUrg+gM~08@h>`RN$ru+ z#q4||z}Nrn=gi2uZ)tD}&8^5$Io^_Z<8s z!~50obXnE{9i*+7D9kmQMjcUhPc6spWbSD3x@m=MpzhiOcntP>qsIaolcE#k#;Bd6 zHXyy?thQF50O<&%g)Dn@nEn0%rN|o~lzx4^YnMU3fCL)lLPKu8^HLDWx*cRHkTh>C zgIzN-H^h`b*Lqf^a#e+-I4PJ33Gq+UV{&G$!2oV`p;tT564||RPT;ug4Q^WZK}?n2 zdl%u+uXAAvOCV6jOzJZ^NwOK;amd~F=YXzRNuUZ2I>|9T z9<9r(U#h3SnL7+Cy}IWvevu2{^0BnANN3iC5!?r|iz)yB*(?|IL8y!P5_uSX(Ygr`sAH3bi8zMNQn!Ump7f(qC*DcKqRNeh9I z(-qwb;z!%BDQ2&{Vj$dh>~b-%?`;i4<9!@l!3wsv3<%KhUk5I^Tof-zj5^a0hPNDo ztnU|3ta8s}?<)2#;(xt*F0vLm&5>+YwKN3()2#ZgADX_~Z7f!|a&%~xwPe+Qs>N+L z|892P*|%MK_HvoMe4e?+hI_k4p+4jYu^o8WtUTk`#qD#=&*y2m{PrlN(c0xhEET?7Exlyn2mir9! z*&`A0{LkKsij#E{0&PH=p5N>42HIO$Ibqf^v%D1ylw0_BuPJ0N(+QDv)|oHmFdrGN zotapB)K|l*TB2N$#JI8p*R~IW2|^U^VUWo0r5{UAyTkJq7+Dy0&~d-Z*dBtc*NRIB87%2sp97^4mdtc&r@%2&_qOphhILw>Q>Dk-%^s3V|6s9m^R01~SmpBl?X0ZY0OaMu zlc`xThs0u$1OXD6l=a}yCZX*pmFA=wz>wlDr51@j-#V&+8$6_`klg~;_DRYN`LPSa z4h7IJ0GxF+vGMShyJp~p%z<fMRm!08v@Sjk8J^7JT8!px&x*c*6%iq{-Z@wp znj%KF$KJ2(mmR7&H)RYHz%?Wii;-}Uf)wfnCdg@5#~C5FmZi7Ir}}lXbbSd-t&^I; z0k?38^Mzz_t@o>sWw{TYJ8W?kZeP?-TAugR4r%A&f3T{JV7XzPx@%o zxD~;a&)ie=T8-s8ZFe7GfU~lOhK7z#=9sB4%%itJu!4)rZKY0I=gSZo)C*uqG5B2- z=-d>uYL5ff_@5yP5B~0v9IU}zW%{+NW>U=Bsh47ER<**KXf8BI$))4Y8e$LB(`F!0 z2nwXZ1}b+%?x*`O#_!eoi?t?1!7R6$jC>C5W4^fhNY;2iFbPRis8RWT%bP5oJ*ruY zik%5m$JjkA%6#A1ez`f3xK{CCM-U%sX;F%?t5v>4AjVmoJCB+)g7SvN@@LgW( z@VYN}jy;$2&j0)ZES5_k6th{XKLpUh3vdE*+AQ5{1R=*X0Ny=Jt6v&E-&9la3J;~& zrit&?*FIxHonPu@fP^_x;oCEip%6XiTjb1pAedN1EPDjsU#-dKl=*Z11Zf0R6d7(E_qn;!jFJPT65ScA*chA%rY$vLUn+q8)`B?Wowo)I7th)MaJWfZh#R%g}iKA ze?8;udPEeGsG7H1tc9`#zJd2k7;FRA?i?Y5(ZP=Mcxtc`)^?%1+p}ZsmoY3UW{io& z8zrlvR_*wBT+hGObbQjtrm#ciVm-ugp9b8TbLal@_&AqgV8($H4qj%zo|qvEJm^bH z!-p7zhlewLMe^4$vN@_9OdC-Zu=?cqF~eNc8#LG0&S&oF5hU4!y;0vyr8`r&`_J@5 z)>Rfog}Z|^w)Z^jZ1%CyHL93?b^kWC6OMKIWY zp2oHm+$+mEA~M8|)4bT9$kqdvr-w(&tmUppClKjw_Wl62L1`J8D0>xQ;XY))hrSPu zF5pTtSxFBfPIHW2t(87>G*77L2pW+M!OyIh&RsqcP|nS{7NQZwBrXeV6+ZeTKA$1S zX)rC>mx1ArL!Bu-`Z*S+IsDX?gkbr52qVgO!x)z%C*~>i{=-t zNlFQMMbL&@7)%}M04g(G0!&X$?e4zoonPRs_ek-_j~@VTdl}E$m^H%46Lri2TiNzdtCsLWGtGYo z)LT{i)iAKT70-wIDJ`7d@t(KWy`O&&Egw1Wk;=P^QPXS4Ob^!$F5A*Frd6Eifs)Ez z<2IU(hwUsU8wO?9Tt9p6q@UUQ#xF7+v33Cwc+H5ha0?jt4PJ=sF#Q}}(RBJ-WjUm5 z0bd29#aL%mo0Wid-PqV@mgTYck*QWxj3b5_j3GdW49G1GsP}!njobzY9GB>5X@Nk^ z`Oss=^0wRZ4(MRuyQh2@&_xy5Waa<-GDA!&6je+#Nfq*TCzoVFK!<^>tj{4WqaVrI z7YK7$JBM#n`qS@mNI-kbzCY&W%qxX2{p=l_hO`A4fbnBeOX=lCaeq^LwKhRkN>a%l zj!v)w1+u5snh87DZBc?cLJ30@qkqzk0KP$!U=>|V-PZQ(gB%M;S|!8KEp2aaZ*F!6 zn2wK8=VIU=-r(x{7JF zW~khnolC@!!+!#l!JNW@f?s8+h802<-$YCMx3uQkPPFLY+~PO?6mo2BCO%O`4ADd6 zFzU2DFhSdhTZ}Y4`Q;Y zd>0!>4pzvAZXtbZZVwy(FrH00Pd(e8 z>*RVnRGz9ZNK&w?NK!dlkGII-f)kD+WeQbk;a>abB4z))%>5t0ZN15E-6)oy<17J~ zLQU(w%lb^^nhkIyHy;!Zzywi$`SNnC_s(-vXN`W3O#mW3`fPEPxiS)Q-Dz7jS=i`VV}eyd4YODMsjgekOJLzpfO{_Q zYBAB8gXSpdahK801AwUjzc<1yneYGJ5AaPl)AD4&;~Cu7k$Nv%0LDE0AX6+l_I{Mrx4xELE7YiVhL$vIta zssd2hq&QIr5K44iB~@wf0Yu02811ntZ1v1XS=_F32Bc9a(0ZE)IG^0S7^~~V1&8`&q~GmmhprVPPS#tlHaO0B&y`a7lb0z_W|mZjA%)EG|A+ zG|OIXaoW$~_p0oA^9)u{R-QIl1GJ(t!lp_o-8bRx@2gPMz`9EcyL^VHkN9&=%kCB6`aV`hU?6z# zzq`}r$jHb+2OLm0Thl=O!|yzq)0P|si?2b1!10SYbO6)C=IXh{LchJFA1zp0mKvqz&b{aW&o5+!!zy!aL!+^#!%GF4Y2x*3J*VITx@pOw$4-n z`O~e?j>P*lzSB*6Y3V7L?W|yNrcPaDXd`P-y1$c=E6reSA2_mE)N8As(Zq5Zt2uw< zVNRoJ)gVO`YrmYYcXhp+$jQm=^lyNHSZBOdlO@ziN3GnDaiHlGW*oCme;z@|d|O?M z?6?V@Ogl7-ZJ}lPB9stx75ovD6{bj>OU4d54HCF5SU2vDq}->h0Od148lZ}*z!2mw z`NQY|PF0u6se0N5Zka9iudUe<&cNa>L49~398@1p0a?$9Fig);4M>JF4*V?z2!S52 z_vJIVm=zp>#E8v$r_YuZ6etzE%rHgW()F3VAw?aLL4ImNb*T9(;rSh|@$S~^BRG%7 zS4W-VsY3LLkH(FOv_f|Q;jX%#kIUQ3BLoE$6x8kQExH~Zs2k&Zf!2fGi4*o#+sfy$ z?rUclD3?77n-I;X1n2dmPXD!X$Geo}o1wz)OCx@&8%emrw>v9@)7AgJ{Q0tavJmyLJ@YK+?-{y@YZ95*vwV92)x*eKsneS`9W4NOCH=dnFkhFqah zo>oC|7{J$3`RyoPy6W$QX1_X6pX)L8EWp={Q!53 z&pkd}o8hzS`=NxeYgF?bX31z8J6Sy83P=U@DO>066TJ6L=sODc3%6OO<9zc!(jfpF ze*fYtD0HwLE9eU(t8~3D`#-v__UIER)!IrX^1bP}3yYWNJ(zv(n+^A@{r=L z_Ki<)qT~QRXzPj%hpSXz(uuS$-u;FT9gR68Sl5%Oul`1n-X~v`cN`~$z&CfElfds3 z2=M^WD;qm_J)QlALE_wp$cY_2P?YWaG|qdT@xlC1YQ@p621}#yEbq$U<6n?|`*OdG zRJx{j_}U1Be+7)rrjDLgmRMdQ0@p!_$H*Ktv#y?Ud~91iqej!=O&CuDZYNnhm8+Ny z4fA>CiTmI{c(pP+tE#1?rK)Puv<&e1Ye3G**wGSboHur_ng!O3<=x$nZ!Zb{&vg+1uNTkB`@Tf13Z0MtJ~}*Z>&}G>SBD zz7IWwgx|2#AzWB5Y&i{{T^aKtqE@Z@-hUFyS(xr|RlWUPEUG*5dqrm22`&UEgw?zI zBk*(D8(jpv)&PF21IVrbSudM~>YS32!_8144%|Mhba2oprKXUol!-I*^NDUkE`mi& zN(9X_+aNa!SAI$sX{37}SV>PV>TNj!>l%nj7Wil?xeWJ*&CsgOr=vHd$N%zb{5L

VJ^sTU%S-lYwK)XE#ZG!0iyo{S*}qn%0p7m#fizLy=BlAXr}n zwyQ~8A4zDfZ^Ul%|8$?QjdDbZ2_D9OO0_11 zKybUBq^{cf?fo+Ad|o}Do0*B)Chvo8&!xt8t+9$BFWLsIQoA9Cww2K07{1~+dWC%9 z%R|{g>pF$G#tD~pUGJA=%NvHbM1r=m=24U#FRvu;!_ZSmUsVAdIZnSV$?i+decf8EI&BZ0)`!zJs4aQ3r0e9a{uxHWq_pe zkv-REdd+&n{s@N*g9rb2AhF=*fe8T`wJwv5d|$jbb|A95PlJZ`F08~JYNK%ei{4H~ z&Gf~^Kr@}xh6AlMrh({7M9ZxTp7Ok~nbspsDKBWdrYWneCiW3kF=K{znWDis~o{;uQ32n{7Id$`e>-k1IR~#_zOnr&up>SIRFVfQ6QnL$PpS^KBI{=o{ zZl(D$1kctTsMrEZ9IK*l5$v4+%`^h$ID>)XxRXiv8x%>nX;>tYcY)!sn#(NZnhnrE za6%F`@tU*WnvmfWwQy#<*cO$s-9_7wt007t^5oIHbM`1&uS6>}F~vk6Y3hIv<2D2W z^=aAYI{vLj7yjPl_BYS<#|b_sO|6J%>;y3lR#82jipeLKN15fgFLXpG)t0H3pFqJV zLV?7PUBr@85PEEeO4b!WABDO<84*&4oQEfL5>nUtr^{ z>)`h3gXXznM5G6>T9_Ih76J1~GDhya9k#YW_GpF5+#=qO>|yn?7;eNw|ZSyzP??$E=?HG;${^h4#tYNW8y#$8^Zz@`6k5(MvIg@rKHR*WmP8& z=s`?O#uv{$h^idrCLB8o=bcG4=f(sYNhG;dc~Cbs;r9{UJMKcARsU z3}CIks=K{$MOs)Lj);3%s@wG~ksx5+M7hkGv62eSzW04b1IjhNn) z=<;lF%Lps^25ZAL4$iSK(O)SAMr+T=*b_r=#xX$ob$>>RbZy366>$i2YBc`0(A);nv zW5o3F!t`jO-gSp8Q$0RnY$D+pD_JF*TPsx>lkH#U5#tgSj_}}ke=@)hL7B2_xM0AO zd~b^~*<4;D{}uS*l&L5PxY6K7o05+6Srx0$X6=hAW*kMxC?oWlH)zHVl8s!c%$x9N zieYZRkUW})T6t6!c>Z1qjw)$?VtX2u@u{25nVr^wNZ&)HIWL=VozHGqocb=+)ui+w zHEEsIn4D{{r%C+(Y5}M_bk8r{Kg~fv8GKJx#h}1|6TPqh97)kimBIcyk`Tni17D)o zozGr!2L(BRj>}T8%0lB5S~)V{?BYoulwJv6-@;dkf667IPt6;`XlF$Ja0b~;{;}4) zY34PmmaLYfi5)H=u3>V7WNU)Za4h^J@^u0t@43DNb4X5|pj!R>vOfT~hN8PHEALqW z*8JZD?Myt5E)eLg5=zn$h7brEuZNQ%c>3Af&#?Z}>~KFpGPHrAvu?2vJvsvc0vO?s z;!S@>lPpR)q-mFg=S;9nVnv8u><~swWx?5urc%$7ED|^2eJjVHX2ta{Hhc=cOhCLKZpJpu3i+X5?9#S zRPx>atN18Y=dWZR;yB=HfQQ<-v=oj~O}64ZFLQP8%2EX~bowh-eB~2ivv!)Csry6i zo;jY>#?StepZ@!~+7T907>q&aiEbW?xh5VQs`R*j2%x6@g z7PZct(4%YlK@)CJs?W!kr_;1qh1=LdEgWw$yr=sHU->}j@Zi8)<(S8l@+uZ+&?e&e zJ|27w?=fv~RUC8c>}mMPE=|0Mg{5=E2cJeNAUXx39G|cOLO<|hI~*t!$u#Skk-Pd@ zCC@l4JkU(L9r5ts);}2Ox7~`tL(guzf2! zcfx#A$~X9Z`!-}nm$pzUCAP$C14Cssx+D^ohhS9q8Tl;d4=IS3J=BEh6O3g^##OOm&jvRgt$V<%o7)8?mKGizO z77RGQc#ZGVdI#$DqA`8VUCHARKQ>+@Z~PoX7L(8(k_I+3?BVEL`FfT>$k-(?CdH4* zV>GZiI(rmIJGKTu*r2qY^v{;bPcV`@fVp;_Ll+}oR+|)pIrGxJ~^fiFv@|w&_I{=zbi3d2_K*jlH^k_ss)fI zlI`c90+n_jOE_xUCAsYGmn&)TNhb*nVWbwEyAw{Gy!10qh=6p}Kvq~q|HD9(Zp5!3e4zoghwWgVhz&Gzf_%!L+(vxe-m%HRoYee z1b))hDE!Nf+q&Hf5ChN<@zZ}@>XvCSgxbd-N$KhH^oFL93GxxOnJ&!6tySyoYeG>na%SBmBl++mX!nNtfGNIob#1^ozSc^Gx=3 zgV%yYKB`moUnHV{{ox?dRbIi6pTuQs(aC_H%4uX z;_xoQMZ1G?f$Bz(y@qX#woVRz7}?qxJ6_a4b%j|%zx#=^d^ZY4=oe77IK_90GoMR@ zfon}QId)j+^o44RQ-I9AcChb_{^MXo(9T^as6wDCrQK_+?L>mJRSi< zq4*fC5mBQZmoz9u?O!~UoYu-hj#rii`spp)F}7B2gTee_DMFeo6x+u#>}Reu`SDnE z_|`j+umix;P#;fIH*=fL;;f!|GzqXYU);5wPaWM#JI_DZYa|QYU1zZVhUc|!Fx4&K zv9Gj67Bbg0WFpq5(!_=YHCr?BlY@xi)Q+*>X3z^omi_qsMt!fKss?$B+&5Q5DPTzG zY&EcJ&vw>+m3h~#+ORvG^+1p3DOc#8$!`AfyPn5Wb&il+(3+r^f;IdX1-)_g6`l}; z0)-%^Gcsngiv)QX=(65?jCa32pMCaPX&{A+o1xa;+DDK_Eu4$j_fM)(Kf7mj(H?<> zO^|u!l%n*sx)UFi^0DWm5H$U%;4WH3kJoThKyS3@Y*k^5*Ez7!&GmfQOxXOQyjx$T>``Bx%jXzwn2Jz81LRX5$7Gl$y>W-pQc2;9P2~mH zC7T$-;Itr<^W)MniqJKhaKow!Z#g4$_ingm_ch=9DC-2EEIs_F@&r7*ww?BSi}F8# zMs4xO%eNd)Zw%V#+M{DoG)r5SN4R4O{&qG6{cbf+{iXAwIygERRmdc7B`l)gX2zDvl<&s#R& zaaeD7bXHW*Yf?djMq#XO`uR^tf<@Xm+fxWh>OYM=&!`v~ENN*sN;g%`(Vyh>^WPGY z1@HX{wGT$>CcOk{hrqUs%q}d18GQHl_I{V{T7L&rEcfsHyu7^Z?CeMC`P6VEe`+rr zm`LNvq2J&cX5amQRFY@_#aIY%4@%57uYO(oSzZ89hkqM+H*MaVy$TgH z$%ep>`vZ_(9np@u-zYMWl0?DDAF7Sz;nPHsbtK z{&3#eBv|Eh-&nA&n;b3IlsipuWYtSGm_GMO;2xCfsEFjAwNK=8Gx_rJ;&MEPhyh5c zGI`zZ-ZKqS*Vfh!bTNRgDFn`N;-|v$AlX_uxbAl-j^JIFg%wU zMrdbM>f!`+T_3nZ$(v&68e*eU&~oQ<=z%2Yy;j3EqAk23jN7JWoJy9e7ayxL>%!V! zI{l^eUJmVXPr#6JC9;TGs%V-!Q%*9zu$5sNW281BH&`g=AZyN=aL*UzD-5buqjmUP zi-@8(AV2~VyMQtQ+O1a~d%!z@T(WDOsDciO7>{7(2=o!Ws3_lDp6QOtDK8Ow89pdtEsR-hZ*m z65^w`Dm5{^lR->KitrDWm6buz$b`JE)_oy}KskaQa1BL`(O|BNBd8mJMLlV#x(K!R zybm3XvzudoQD@4lb>nIo6@ADWw+ zfn=BXu{Fpa=X7r&P`RVw)F%zn$ZdfV-=GQBDVwv)#cjE1S-XaNZlIcAt7XA3<&kJ+ z=s4H~)>E}zcSUgwb0BnM(F!zROv%><4obD?#Pw5#Zz>9Hk{o90JCc&IviN~j5=4Kt zP~Bkmv|3K*vOV?u8vU@N5Sm_o7RXEtib4d=BH}0OL>e*GBI43zoK6s*P#DQj{i;=~Gj!Q-E0?*4s=y}J3k_vYX_7!y0CWim8}9?51vj&obc<%$9pMS2svlPJ zPGnMs#h9ACRP(On)8B1Q%?&i63Q-L8m_lo;qYDJ_gNVWZ$73|Es#NNGC}=yIJev(i ze^j#;q-M)H1oG^f#ZO0Zmo2+aT^>ceezUHUrp`{u0a%0S^T+W6o720f;zFmipu2z3 zKjVLxUeR{s%MJP}yH6h@ zTAaRy%1+U8^S$P3qk;G+EA8o%{s36}uEhEfKAqjhj(nLug8``X%g1+$v@EGijh(u{ z9roQ#(P6tbReQ%?VrqP==&N7^0I50s(5-{t5x~oAZO!Q0aH`HDx^00yD1D$abg03L zAD^HL?JHLM{AThOD#!1ky?#N+`dq@{?n#5hruCE~cpTp6Vvy^~y`#jQij@$rm%uJe zKH@COe*?Kmgn;{$*+UYc34WLQchB$d6aL+<$eg-JBp7%pZNnB1MP9Kw_KAg`w4VMB z%VDDrjfY z1S?hgPHsR^fYA_$sirf&k_zLl+2^63P&Dwtw76dT-n44{02c8bfxt$(Gmp`=O2Oxk zo2`Xr^|WkaQ_shfKw%f~q*}oq^xwVYe=vy7!G_zF5!=Xc!F45!wh#PF^$YdHgM)85 zr>YfmN!A#^8^f!q=|HF-2#Qj>^^T8f&#l=jbai<8rYR7fcJ{onwY)DTMHps?a)eUd zQ~~ZK=d_`~0<0*T%hmT`(hcPA``viW2CehKH zE{lS)p zPvD;RNc-#TH!|lffIF6fKh4-Y#K%tru|N=~ae&JI2G zqV99T%`qi__6_4ZntSfbTKaxUsNW7D33)m_t<%>1@z~hRCP@9hM*|aCcn^gA-<5uUnhNlJItxWe|lwp;@Fj+|-w@!w$u<8`+MhOSlcQpbS zT-R35?d;OhFh>`#)SCagmR5|cAnk|Hda03=bjl8)1!t977p|ZI1`FNu45pG!FuGL9 zuT(KNH>Zkx%i^l^>*qN)%HMOKQNI5gs}_%skh>GCe>M2Fjp};6i+vraTHtffkGHg^ z7@{XfND^%SXMc}OvbEEWv&Wzl!~t?5AB(~}Eu&j5;{G!(%IF!ldqFo!recKYX|PQngnYx~!}8uRQHt zEIz*tsMaY=xAoizfL5#2egujhtV^vR3wb{}$2ia4#Fms1HS&hEfghy=l~LocWvazv zyiNZ4w5?y_{sgl@bChw|`J9zThqKxDRcW5;o{euW-g~n0Ine_sjuQlg%K<4Lmv;>h z4;NMo=s$ggs4@ZZJHPb`&rh@+WUNb3$)eq2$DHF}wB~)@^?sZZNXZBDn^dS#Q>X2F zApbx>mXJTYOsuMWs#1QFxIZ`h36#$%N`tTwK9)XIe3W5^T>dY14}mk6_ir9MXU>6f zjx)DM|88M>>fd2IPL##6dOwqh7Ac!(vOf=5a?ZW%Ospj10YmaYKpOTFA753MSBGQJ;zHTbB@S^d2z$@g|Gb9P2<~CV-NO zTzFPRw9U7El82+jlhd>osg|fr@^6-df%z5q`^N(J6sRa7yQh8a@ZE|U^tMx9T{dll zhuTvZB0DYLeQ`};rZ(0ivhQGIz?I3j?*d15b_cY}*DJF)ZI z6G)yY7?@5rf5m{HdRL?Q^^4vR5@D(uS{PZdc_Q_*R*dK z$;LYB#p4UxG=804UPT+!8&l4~JQ0E;UN92(WV;gUS3 zhV9zXLdU^MQ`hp#&f-_289!=JA*^|i9?fqkBAogSaduRC_u!u)ig%oj4nwVvx3_kw zJWW4Gb^`X%t8L1aMf*!-GZln<{pMcWcvTJr zNnGXONbN3bc>uXq+TY>2`Y1RwsW}a`CF*H`i9@Wmb+55YkCX$Zgs1P8f2!btmxU@~ zm;g6B0x^%Go12@M*r%9nl#2v}^p|zflo8BZrzy5EhZT_wk2!q}HI(4ut_D-Yh+Gxg zq~+5P`TaO11Tx8ZYBAhg4uR10gZWs8`+Rou``6>F9~Epv0>vFa{)ENd2`|F0_3{{XurhIP|A;fE!MzX@^KZj;N}n7tazkW{Bp{(Kf(5n*XqB zb(2qRPhd9*Vo`hQv=FoG79OkE3C0?MlUXuerEHck7P?c6EEq$y1@M+#2UK5gDFp=u z%T0DboE(u06Ns{Eb$I)9kYzuY8t8xjm@DW({(tB_gJZMeZkje;eFY(3B%ZV`&@TxT z6aV>j6-hCVa5i+h45<70nV!0=v@g$6ke#0I|I%@BstYe1+kfjSOiXNZn#fAD^!>Bi zkeb1|MFL*eWE&%T+RAXx6+%Oe{bz#HQ1&*u}Q{Yi+dx^LY1 zWHai=`#MIcT|%6U>C%MkC(l|J0bfCDCNMd%f^Y7xPq#tRKKDqhoWa|EG2pq0c=lJ8WtWQ2pt>Z@4aeL7T<J zwtn^=ZcJG?%V+XXzy#(}=O|FO&IkGv4ShI-fPyvBJ};<_WFE0YSw*O{%aN1i}ROWP*HFohPx{wvM z=-cbv7l^~aFY>LpoxW<>s+Ga5D;)1Fj$rh-hoGZ*Fxq3Kc`)dKF)bZ3fJ-$yq;wXJ zUZyw+uKwrR=h5W=4-w~0w@-uibd~Hzn(#R_8=B~qtdpJul~bGA?|!$3k%^2$zh7BtPm5YwMipwJ zitbs!`O6mFe87iqRwLrKl)DH9{w4(mMuY?TQVbj>r-WNWnFE*_0Ul4fcdHddX8N(% z!<_a7WvMT5NQXDy{$TJ5*>C{PFA9qv~4 zg~d**n)9l6TFV1cc;dodQbC3KpB%3C1U5Y^-g}-JIm~3D?n+H?XfgTSt!$MJGs-$q zli-0p9r8nhF&(H%2e1Y)9ITH8nuflYw}VKTx{3Ey8>r}&S>goM{jyeY=9$eyr>|1XV z2u(y2Nk8x}HEBGA#81>M=Ai-!7(mvq`-e{AP!^`^*pCNdw(vdG#1D|bV!9=D8B?UeQlmNWyXr2;V- zOa50>LmfLfaVU+7e_5&4hlk^(6)Z-rP;+=D2tLFoyu?{CJ<*pB{k9->0)^=wORv`7 zD3`5gBUO(g(0srZ;xl>;mP66Ul{${Mqz$Hf1-No3FgXEwBrp%*{~ORtK)=8*cyNDt z@Mt8Cp`xdhiDyev?XT%S-(=taGl$0GvjA&$lQB5qgcxI-Ff3YUsAb5)Frwiy8=iS8 zS-2%M7FZ|s+SZ#j?O1_W_h$o(GH;ee06(SdwhoNk}c6FwD{JRttzd?<#n$ZYuYuBQsoPjQbr9UNsMQ2?w$~2 z$05@jLrDv=QWqGsgsj!g)NGRIMaCOe6Qw9K6HC`H?`MYSC7Z|mEl`Ch$LS@EllX&3 zJR+AoxMxHBi7@}qcT2*%rzt?f@=lHJ4qPGp*!g38<*n>3Ew8(zy8M7%^yB)vI8plf zh#5hnA;z_-Vbwj!LkBMf5GK4ZSIYMTxKM7XxnUOkec{WqM94rty$p zMr?pEQGJP(S|~~}wu=B6Opx~f1l0+jfmJ0E1Z4KFFWp;3ze17>Qv7U4f{odDnXwXp z$>jSxKbDiAk|N_MzELZ>YkektfQY^2vWi_ujXh@-eppYDO2ChE%YK=8dTD*6^xE)w zBJ%{aP?tB$95SjussuRPyxGi5;(X33(SL}tZ8=wWG|C* zb@)gGDwmWZwi?H;p-HoGPkcDJ&g0PQIpLAY>Hfa4s@dH!|j?nWX|v z4_!2LzA>Gdr*w9utUerxn%_&nS#?|&-+DvtfBmLfkoCE(RSNT0#B{V-H~s(Z)nvhF z2ve8W)@_la4VTzL5o$#T2r4E&CJD6DS}l?FI?}5~$!)~=yosA5;HL5w*3-X?JZvl< z`6jheaE}?(rat2XEgzzfh7I%ts0XE4CEUE>-6M!UX6&tgv!5V3e^aREZ5ZM60nx?( zzuWOIAVUn$r(dLKgX3s}$SBzzhl08kjb2H= zk+vC5sjz{oApif}?g(7)`31LRL>S-BHXi$7JAvpj2A%&oYlKykNVTFZiQfkkf)(ieHM3cnlQ2i}Rh^I~-hl!2bX!e5%0P-RDQ!Z5p< zcntg=U*o&3XR_r8xR>6q;%=MXhzHYklv`4BJ)P%R7fxL?b=>AAr&WZ1{Clz}7E;8( z9N39>_?1te86`=D~+%!^RH`i5KltZ@=MR^ot2LZaNfrSbvU_qzw z-S1g(Bbc1k;63Aq2vE@j;!Tne#6#}3EFR+vBGopz=@_1ZBCSi(V2NNVltS{}jIX!} zl1{BWYZzOj&7S4==T#^{`?=yUm=yHk!xjb%PjMf4QKpKdd`S5Q<~GX~ksyf#EL`$h zb`JM#9?x^6r;X0hjF)|-bDx3x!!B^~m`g;rlH@^jEGi3m&ZfU`y3+}y!y@0T2|{$N zr&O}J@mwp?N-al9lREa`Id5r@&n@+%v(~H&NY>U~Z$G{3pam!(2r;jgJNEWwPyQG$ z2||oA;&kbZgdye>fo;!-N$rEdDZD-`E9O+0AU!zEw9LGW6Na_DW_G#x4!+0y7`NIr z5CIGen6Dhu_bsGJ9g;vSnk;0=98ZpgVz`Ft7Y~k^fd{Sc^BN)N1|q%(fi7ZkY*O`- z`3PtwNz{nB2&5%RG?^mya5?dk>;v|2J%59Bb0naqCCG#9)hJPf&c0T6Oe7g|l;Yr$ zkSFA`ICau*aK&^sL!a0GQgpWM2}1pb^_m3U3QQh`Cq-FRET68-hEjQ2RkzXGf#W{E z(C{bRy$jzTCXd|kfnuxc-X`yG_z^uWdb^)76|k@(PA_rf>-U+P6*2%Z6F5vx>u_mk z=WS*H0gIy(q0gH}Ab#N@P>3b(X1v|p{$+PZf^HfGGKZpAAsc?*Lpu>hkrWCwMMOr- zc5%535@k8Aia%IF7ncr{8Nl?P6UGbLj7!V)I~$z@iyh4JKV6&juOxk zeyjv)wx83iizf+rabUVZYh?&&!+_)^e99ZX#)m_}?#s|(2^AM^op{-`A0C{I(|l<^ z#dEW`ZH=QvK}l6U^@#c1NZn{Fr#)6s_E+45-#r@*j#daJT$dX~h_p(=m*W4a?Y@JW z2%|-TgNmRa(m_E=04Y+XOOsBdh#+9-MWpwR2m+$?UIP+QItWsv1PKtNHz@%j^xk_3 z((cFHd*{xb_x^bQycuSa&9IZ~e&3$mWY75>HtvMyw=kQ<;}=7tH@E!{O;JVN6+Vk! zg1LxT$|&R`g30FM8MOJ%grKTN-Dfl3esRA4I7e-3cFAc^`sIymg!PLzI1d8)+Cgi# zzM_%Zvo~ zOSpegHAn7Op-RlXdhx?5CC@tIKgQ3Z1=lXPe0F!Rg#AfO#E-b7@(pD#KNgI#L`6{{ z81A3CcI{uDj>eiu4_{jBjt^d*ZF)oD%0$qw@5!_+P3^q!T_nsHzzMdkS>@(D_^s(= zex~I|Qo?Jh)i7e?NUO@U?G5;^GuHXr_k#^JHjtFnYRlA3a* zcvdr%&HHpyrz(sQ#8e7$b(B7k)HEWUs;C@zIE60PQQL^V19Q&YXv62A@6se`HiFsV z6aM(k@(2Ig|5^ke_%$^O}X z^LJU&%k21?K14tTvi9gtpXuFm2Q^S3WZBY=G36R1;{EK3dlERbS~@sAJUK9^9|w0- zTZ(B!d9Gk>hlo=qs(ma_|0u;Tb_>mQ)?z-ZtEpAoBOSQj^wRBgBgnm>t51it5zFU- zW#zM^O(yZb2*};7@;mr}3ao)M`PdwJ9-lh<@%tU5#><|otpsu>2TLBT8xMd~dbYJ>Zm$QSU^@CuhhTU`YoIE<(=^_&Tv5W$=i_!T1RFiss$%erhwqf(JVJOc zJ9H!4Zf)~X%9yAa$-CWz(950A?fDw~O${p?bbdQy*Q9af*@TGUh1F(`sspaF&HY-D zfbC$dgn%=4ZPPNhuX+;h;Aef@-qEp_Y{hJ6bDgs7z`JP)2hNLozP;{e%Vi=tj@gJ+ zF4;-)xU{rIXQcVKZ9YvywMLgmt?uRxg}X9_UkGJI4`veKQqs5&Mj`zN8G&{l!iSud z#BCexrVx@AKE9u&^>VfDIcC$b)Bld=9hV804bJ7tOF(vT&c&LJG(oRkES3nFOYTG@ z1X0RM_|@UzO-x&oou5dm)dPeAkz4P%yV_7WQfL zwP*fL&FRkq-F2S7Ps|cM9pbPwoVqzPo?vuFVuKflD)WRXef{SSpod8Uy{N8ZTm%w z%26ljRDXDVdTGV1d4F0CXM`0@Q9i{dtFlaLJ6IvwQ_-J8vTMD*YtE>5fEAwEkl*=AIspAHVG1Wc- zZo|IkEXQakk$&EPB<|H?+NT z)8OB2OMDvS*1RzR6ngW+jpB zP?F#yctKxmg(eP>lj~VwHwO9=V~%6%Bcw)5jcGdt+ZF?ds>agwo{SXGs3{{p9+MO106AWDnMwY5BGLD>NFTSqrEOnnFfNmw{p?AER@xN&Af z29A1sSN!R%{IAIgc zYLs(ys)V45RxKA7o1fHkE}rxb3f`nzO}II}7{oW`pl=}^VFe8id!4=5UdA6bNfxGG z_Z~m9v~OLVS@dnlCalvyOMHnfw@5nW z3^!w*Ez4f=lLZb8+XL_HhqC1PUNb)+OBve@;9EFde6oRz%IESoEwY#<$)e(N< zhrEdkU%FFIyQ3spcdSop)A$BDmZc`tEx+~LS5C3Y{}bj8*;}9rsCH<@_;YiCJv|us z=O!NWB0~`ldotT>DRW0*wuSaMLA) zhY8Mlk=7c^^{$8+ou`cC(Mg-rEU*Q8DaNf-wkT4~4v33|7xa@7fBk*H7(wykPt4y` zr!=NH@(jMqg3U^_g+HUWWY6dVzrWWt)WiDR3PJ#Dm;k9$;S=eJKMGT95zlgE?9HK7JpIomcj~*Tlw9j4&(F^l)H-N}sS~jBZYo-~ zce{+u$7mE4BY5^QCzgLSkZ!rU#5PNlVhh>F=-YWm?xjeAu1c@AZmTtrOZeI9xRGpm zkNfgvEmxiMZMly#hP-7kikHDK%J7whNu%$0OU%njc3O3kGpe1T>2hrElef;hLT+OhCr^PKYUsiW z+R>$^Z}Lh1K&Z~5rbeys)^IIPd|ntNR(GN9Oz2(HYiY0sPrO$r3f*e>GVe2;8eEU&g3mF!>SblV{T_IyMc@OOpcU?f zfR2NU*k?!>FwBNJI`bY+Xn75Qlll`d2jEs1zwSCA9`5&RC=Yk!)GHckOlg46_(}7v zMc_b0St z#hqxa4+^v&(GQCLBzIpj6z$OEf!p6SaCv#HVTJP&4KlH~(@ z;VE#ds|av>{(ez5nn4ozU&sQ+>~Tbn4zy=%~FQvBDFdf_i(FYSoKtN^XG z8O)He!cS_04Zb<2E#8NAwPo%@=TSvh7PNk)S�xP7?{^c~d^nS5Z_E$3AG4-6fyU zQFuEaLV~F#fJX6XMs+Op(EKJ)(x3^i6y-C_^{X2`PVsut5tF{=81G%I=o8 zcwG>zTJV^QqAQ_8e66qad0b4xC- zmq(L^qx<34NXoJVGGVjFNM!szt6&&sztW|@?6m;@T%MUbEn%$|nfr<($`JCFS|90; zMMb*0y5Xas?TS>JZ)XJ$ltMW!8syA&`m*jqiHf;(U=-F!uxzjx(xSEjM3kTYgpV!-0abXiC|hhLqa@~7t{pX=}wd0W)~>2 zb79u)r5sv&`>J6X82e@tQD!m!ig&g*qzuYYv?#Af-Pvs z<9j=+#&T&9wb4-3s8XpLUpv^!Sy&GV$Okgzvx=mvAK%)V6_Uu^*amGp3ySOjqN1ck zKn_y5d0+it7JMWob_{BP?-{veDi0JF-M<~GjarHddU0Sm>JueDWCQ83c;!@|**3C1MJ7Pr8ccH61{z9o3J2HC?XiqsWz9?4tes6M7|u(lsd zz5A|xLyccqwnql8*4_fuzrhM-Vln|aJ7d-S%TUOz!A>m#OE#fFYB|LOHj32wM-;}t z_z(j#mA=BTj?@a@mFsUAis&XFFp9OfGd*hUvc;&jRynWo$dC=~pDm0V>SzHF4s>-> z`HcSoDI6sKqCh@yb@dU*S$~e{0vbd@X&6PB?%acm5OE6Y<}@l1*l@zvhmmj|i^q@% zgM{B~EbH<3_8TEj!}sUHN8vndP_p=JqHuD03M>WXUM`)ck&L%scbT9LOGfTqN1Hxs zFBw3Nr3OE{)(->b>8G1S-0CmSW#PRi`2dor-n*K^Mu4qADTeqI{^{z4;Zvafl)KEL*Vfj6 zV*n@(k;&dp<*QXx%aKSV;L8AM^>7LRQPY5_vG&VI3I(ZXcySiM>|qqO0=|{4EmTwi zBtSilSVhV>+};us+x^e~c%)ZCCwiqAK(D@#g3K#C?ULGBoOk2tB(P=G6^UthaKLky z3A{M-5aV8-VFCBpZT-*y@gKDBFniKE<*Z=b<#12tFW%l7uarh0UOc3tmbWq7xp-hFz^hw z3l#MHdTN1C5m8a6sb3N_k-7CO0=mYvF6KZJ1?S>bC!!{$dlX=w;R#Uv=ayJ?NZ?$= zC$LyUBcsf%k4-PB!xjDf{PLb7_@FopF+!1tW_@ELQ`8aum2=gJ81F^fRr&!QNoe0~ zFrGKzexDKm2ieWv=)dxZ1+-81J6tn#sMZnaPNNJ5_{4KH=>R>E!=E)+>K6 zrs2Ll)c~x%FGH(FRW>hlbuj=;`ovr5Fjk=yNi*xkE&wlov|wjPQZbaAoLFU`r5UHJ z!!rX&6OADre*Wjbc=`E(IIL+O$vpI>ZDx)AJ53U0&HxoL&PKRs{ohQex@Nx6{ph?J zXq>s0rORQ09&y*LL7NDIU*>e>ucF+ueCWd!Nm^8$6Pa87_xfnGysj=iJw2r}U=cy; z;NUoQeE+$tk6$Ln{c-4iO<`96^*G&06A_sEM`O3hza4QFF zO#6JMd!O%|l0gPZVqX~b<5%+EFmz2|Q#@inxCINt{k$uPL*?nkoTU75KStM$0py#& zt`@ce0$X8eDGD?p2w%DKvH%WBm}&}?6o5nyjToi*E0@G&vkO~9<43)cfF7%Ia;T;j z(q7GqxM3A0rrstZ1CVD zA7006BA@r+0)Ws2N3LaiOau5dpq@w{^hlVVc4@gI>9wKiU603X2@a))AiV`x#@~yI zkgItajG)fsIw7h5k`My+(@vL%h85Cx0<0JT_a$|WA#QGNJ3G6Z+fRQ2j|I3%%S%g0 zQ1`XJ)Ue+t8L~d{%XdGR01ytqYQF*z1?bfKtMQw1K*UkKt}&Dq@NYFGB?YL-WG}$A zU?e{Z2T+=Tv)%S9x&gEbuW_AMhCJ5T2R*q>0P?EB^v+}BZ#igR8{3}vs^t-Y{6GnZ z6ll@`#_LM>M!h=)zDK+V(9P9FLEE1(;J!sfMt;(8u(4tOs*xe;+6P*;1FTt6e7!I~ zYwz@2KJ4ho3-S;6Wgp*-RPca0BY@xE)s*m9AtV1;T^)l}2G~*vqtsJBB9^c)L9eZe zIur_pb*guC8QH9vp2A=}0qyvdc?YPZ(}0Y6q+jX}$nTp>>3{$H`GdjyeA9d13+m}9 zLXH_7&9^edGoz4ix}MV>&#DquP*LF~u=XW1a2LLr76c$-#-g0+aD=z;Y#Q-NbuM&|MM3B&(^|Y_@Y%4+i$9 zwyEhQ*x7b)WyR@#BQ;rp7bodL)_kTYe~^9$ruNy?F-k@8%FF@jxZA)A0aWSH(UI)M zZY+pttRT+_SYtl|&i{eZBoJhtjvj*fb~VvJ9T0T;&9$Zl&?hR5$TXHM4b0?9sG{6U z@I3%r*d(w4t~nwig8Gr30|=&VQTM{@K+C`!D;Ovxv$3`1;^m$EVcr79Gpu9L4THe| z7gTnAWo75|9PIM5t4?~jj;p>MU?@P$I^X#u`%?EO@YaEptASm@Z(3;io!jjQP8!UX sGYlYRKD`OX0T1*$z6zlK&kO$oPnvtCvvZQ?z{kgfDrqW~%9{oM2mNSzg#Z8m diff --git a/man/figures/README-unnamed-chunk-7-1.png b/man/figures/README-unnamed-chunk-7-1.png index 24c2184cbd30479a8b0f9f4d72dd78319aea7406..f97af9a56aefc4e3d7709471c2419b936f838129 100644 GIT binary patch literal 7893 zcmb_>c|26@+xUHEG4>^E9&3@M2MLuCGekm@AzD=QM4A*@tQB*5C`I8xlq^SyiSSgG zlBJ%qCzGXxELk#^$iB|Z?@aRizVG|j@ArP*`JDNjbME`TmixM{``XTR>K;u39y*2?4 zBjDi#JPrX5SKwI;PM88O3J3}SA>kk@5yUeL3=E7sfRV>0BM&1Z4<{oJSECRkqqIV! zoVsluV4H{BHg8vy01*(0z>`QsuUKMi2Zi_Zp-`eJKDm_WT2~L?>S5&iYQ)V0xOr@H zd)(~q0o>1cd-6C#8S?bx0mq^@Pu{QCvlzWPJd3#~3LlD(4<*{i2fcEAa{I$WKzQ58 z)gW;7pXM7Uz>V|X(Lc#VQ=+4J>vE%OxiJ?(ED^m>Ry<=-c49qai(_Luieo!EVmr8u zc)%DL$%z6vt4IM&)cf8KOHfHEK8Iv?Q8>CfQw_i_Q?7JH(UxJ{nij#zF- zF%MaPE_X1N`;!GOmxr6n<$7Cjj-!edIJ4{Ec>qLT^ZrncF9TJnLZ*$Sxl>Te_tcvg z6+Svw*N9eisyV4r7G~c)!hZF~LdWPEL#=5^_03(R&BMZn?OMx!{(C(`2zys<8 zr&AZek#pk#5O6A^mk0r*m;K@h0Mg_CGmrz=;b2$uMX8@8x1le|)S+<_$dmjpRC11m`8``1mY@q>9CaE9@n!9n1O5=JYa~}M^e{i`z|gBtdD;v6|B!>% z;AjHOu)zF1KIMLgln`}8b?KF{@~uAhqFpx+(L4k8faD|tx(Gvzd@sOCI{@BQIx=c z(4Nejp;~FO)oU6Vh6s)#1sCHPJq9)cPD1RFb%JDwCepaosc(GS(%b`a(D*iA0G6N7 zyH_Za0i@u#`9X7+6SoNnNO(&kIB0Myq%g>x&qiXg7rDDF^91ndL@Pjo%~LTIi}gsJ-^V-6H38C$rJX4?t&kx&>wau2wlc0Ga6@=!qD4wKXQaB|Maq zSJEn^C(2h-a7(zy5wx0x2pWB>e92-zZK^h%=6uff)!gOgEOz*k1+-W<0RH2d1~i&R2tr0^mfZWo93r|>2&tF zHOv#CoAJ}eQQ*xAZ9JF%{Yio%cYCL~Bz!Ln!`!mWHbmwsB$dLtmS&AbSjNgV$oroX zB;i@}i+jKR?y7g)i>x0dmfj~!GngwqT}P7pHhyt0c|1MDt5h@xW#E2PO+oMh!hkSs zN1)fK#_r1TEAeU}n4#ef^WsA!Kx1v* z6dYZ4c1s2@ycDgEbei!wPo4)lbm#c#t-ExQDpX(;Zm>m3NeM(-G!}(t4}?yRJ?+To zRX!``@^SbgLFeqXIIj!|#Q6~83-A1a;dhlmaf1)|JG;^}q~g`OV8L{?TNpnnpEm{L zo!_;H@gywu18nQ&sZC(`4kP-R4|=bKgw>-y!&@oL3&`@{EY$#QO%U?~o4uRd&=~Kc z_wqP+2iubPbiSt#XK>`;4Lo6-U6k_bCKY|?w>HR}+(`K@+p`IPfu71;v|B|~KKwHw zKt5D{K#fzq6*~-3LA@vwm*M(QMw=~yK~A$zH0=5&gPsG;9pn?J)q?seQlDm_aK?7Q zGg1IPH_^0?XQeV6(7LPu26}xdnn{=xl*iM{5M#m^)K_;WQn%orp}uNi9!qUG4-#T3 z(?1nDk1l(o9?rb%u0ou2#88-wGF+et6=w3LB zW6XW(Nl8~TlDwpv&1TK~3u8Rh@ds7}g#7-v zb-F2R|G6!BCw@WE`50U0)kPRxg`BwL4aa?5niyaafP{E%szFm#`kkfbBwvPaTh`1g z<)VEt2e$+74ma%Z6=f67WXsk|<)ZT5{ATi~{o#@Ci`~YOZ)3||^-R=k_q~Lw+Rrp) zTlwZmT~WR)%E(%2vN9^#Df`oh(_LuwUE(PRp+X2~nsDD#&zJ!`GP)cea=!Q=?VUR1 zi=c`KD%u4-pACGdlGf8f@+DDta%yhxC7Ct#1>hf)!PLrZK=I+PFn!l8o^lAvK}tAKnJ?;W31+S`e;kGxE);?-q}=yWp({VR}`7hz!+03Ql?)d zJ`CVw~2LKKVgHqo@;mM&yqb< zP$!7>qc_^ISReX(>;Wwi(1xF11xM0NOC>>$=Y(AEdFRmNH-#V>c%v-L4o9_IFAG_e zIyUSUs+DjOGK7*LziLL-c~>6Jha@19jztc$?P4Yl3#kY&#gW%T!YAu~T;$E>(uZW~ zi$EL@frx=}g5-u;rUk?>AWwOq4(!t+mgx}obUsK+ss?%B9B|{rAz%f20-actTJMP4 zlPi-tFwcHR#mIMYet~OuT(VkQ9R!92nXg4!Fp{9r`MFH}Gk6h_$4WKqmcbyD04i`f zf_iqUHJogJ4#T{3%PS*Ah@pt+lOKzEtq1LLNbnQ;bc;vqh8q))gc!d8cygA2P@qWF zF5BbPK_Bp~B1}0%BCGqw(RtIQX{|RMm6k#SN63vp1WWvE93TnrlK|dwRN;v>r(-t; zc@q?D>2*;T2Q%P}W76XMa5adu^Y&^3J;W8R295E&y^K|&+txHjqSB)X=uWp)pVvds z6urKy^307vS8^VpK*W-*k{}Pcr=J!A`C|;Rw97obU!4VaDY>G^qgNs7Lx z&~d1{n1hGeuRol9o|<}2;1(73N3*tnlwl&lZ?n^mWlnqK*Ey7SERGI_m6&zWL^0o9 zNmyoM3{?XEiH|1EJpDP_UR8pFM$;##?DjyE!#+vnJ0ue{=wsh%LOTTf%~^;a$5_W{ zCzOctC63}zpqfT)^;yFUTjBFdpj8Li;Xi%dpL(jX1kEmlG{@Qw?)~gu7K<50eUd)s zj(b@G<`Kq_k9I9cj2A<9H|5(vxGqQTc@qG>z-El1cH z-AN5;M8#=0v;|7WN|jhV%6+8o%6pT?PM>ifIODDupDB+)bRlP&PySJ%AH;gOz5%JD z5{Lsi!tMYeZ#@_mXVzt9wah3Cr??s$z)PG>@^vj0Pr?0cQ^7mk}`3j|qTuTC7h09<}fi^>_%j_k);kOIXE@vVmf@X|dylT`Q zO4C~`;u)A6zFIy%){vcvXME-ZTAWlN6Ltjc(UpJPNOC4ufzPluCUA4&oj-M5)>03P z*{*vnr^M(|ZJa@f7

Ntyz zk0Oh4FOc*1!j8#w7t?VxGK0wH9F8V*&nK{MVb|TM7s+i!nNx$?l#dvTkvDqrF_J4b zk_$+|3sG(hFTh*h@+$`~3A4tuOy4`~H?pU13e6AVW1ZS6d+dt~9&t9px9%N5wpLfT z5X!mP-HJEM`abTIeJn~OFp~eWhZJ>1zXlKX&T&{V5Y4$NK2xKtC%wB| zKCjJ9L0I93mMn8G_n9HqZ!R#Dif3BWXG*?`)7Mc&YhoR`mh)m7T$5TP7W%5DQuxRv zTR!$Fi*_$Hq^O2Elytq(r-=lgZKBdm`M*u1g{eI54`Al?eA>MD$FsOV;Zg*xo3Kpz z$wA0p>lMs*_$q1CjQ&)dnK77GBiq{T;(S38Zr5IvZSU&Z2bZclZAK!-Ll8Ru);D+D zBJAn?eV?*Vja(RcOl2Yd{nkO+5c4#-ul%;gLc{KOS`>5U&GR7OVhs$%sO9+Ajgnc-&pg|Ceqx8wo7^KiAzH{uvh!W)rQz2b3FgOUaHtm@ z+9VCT2q?Bf$mbP6BLvk9>fN6&ENPLC?1{gCp#^1&^+lNQiccyxNNGG~iC=Ren>h1f z>#G~|XC6P}kyh&Co6K*PEiyS8s7Y=> zB7WQGb#aLzJb{)^{cz5dykD49x&farvo%;j=jEsMzo>kif^g+vbx( zzKD?@lNbh#knJ9tFKGOtER~~93K{7m+zR|>Ebng;O_DQp(J&*-1&U;wcjC`%ub#s( z6?g%3h_jb`q-bTwnM+veI&%CRnjK_9U!o^WAwN#&1W3?@J7iEXoHg-@K(k9QFyadm z5}BbOa;fTtaL=?#p$6O=Iw6YPrr5WHp%wF@wjW&*$qb(rV$!Sh8BsvDX5JN)4h4H% zK1mmeSJQwFM^A(RzaYPnGwxQ3SCa#L{zlEXnSB#>T+@yvOQ*!Ax^sKh+N(j-KY?h? zyb{PENmaf$o%R|_jRc~HXmrrnBZ>Aa05Sua2176rt#csFyg z+}~kL%hY!CtQaq3gSJzRXy&nb(hZmJ?8=G-bdn@q@>H8j7o>&=+m=ZQu5@tdSfo%# z3U2=??W?LvsF|B_>HuduBK6C5I=gY2Cxw2|p$jruatVe1B9(qwrB3<9;8u*SarKHd zcUA)C;wn5z@um5{@DfOoz;|`zVnIQE8UdL`RVIKC#t)~CvRT^Tff(7IrVNG5H}(|7 z^ve9qU{JLaVC{#x#5*bc{f5^ov?>NCroYuZW1r1B2Zi_zG|nGd;<}+CB`L#YS7x7v zDV3QHNWyV^0Fi>n%0okE!+uKqrzk^khE*Eife5+NVu_!X=dAv=Hx;)DxI{6{Fv*E4 z>qImiR=MRK1HEVky3*=WAfI$uRZaus^6MaGF8zjK7O$FU60S9E^%;xSIPKk1aKe8b zkb}`q%<9h275^!zZUy-7Rnb=RGuu}s$a6j)IBOvm+JO0~Zn{2V)KvRR)})Q#;3~&- z0rH5%s%n4c#V7a>v`${puQQaldvyy>vEu)pto?k2+N);PBtYJ=x<&`&{cDd?nApNq z#yfz^_0{J=K18MPZ_qSV|H4_A*Wv7dTrM;3VWve++x;3DB&eVj)d~y6aN>s5XFN14 ziFO-#4yv;fg9L;hli{V`nM<}H z%|oT>2&ar#PR^g*2-;6_ zy`Xail6CznNH+4-{`R)<8irawS6PYzico{p<1er9QJ|m_#vEEZ^Vw)8>OYDlUT%xK zn{ShBEe*$&ai!HeyEnklv(cz;N;m8dOGS>Dr`nWOI>S~LQ;@&5A9K%A2mXLUkwL-m zn;As3iz^s6=KC8meOW!95je?7O7x>Ifs>YbCNvT9Ygr7s{G&iDxs@Z=s>Ed7;%#;Y zvpXr)Yj@nRAzGqp4snXG;n#}wQHOtAtutK(_PIa%blxRA8lqj!Tx!8Fm-GxpS%xd} zB{_iKThXQ!^pD7CGzuJ-SNVbwPU?WD`B2uO)<(Aq9Qn6kuF1&w29S@oL6)&S7pOp6 z1)i*#K^Dei>}>uYy6|u@Fb%pm^PmGbS;A(RMOOVnU7jz7Dgh}hJ}v+28wio7)Y+1%%~MHkZ)$|U_K!8mtKm^pa1gzpI>XrAwO1d*Iz=?u0KfJ!ugkDHuqnTJt=Y0x!XC&b$7R- zmmJi|?RuzzmY@nR9;zJCV@Kj;40?VK(%$j<)@y!hlnvv|CSbIhyRBL?+?30gW zo*O10OQ)WG2!8hUArw5^C>kolK~$$(mZNmuhFO_$P)Lhh~Td`~j_h(1bmOzo?}Q zTzs#Y*5goVsR!P`@5;@JW1zN(=X>P?Jx>wtcKPMd=ezL0#gPpR&Gp_d*J+9^}RZXDtFbxn75mNV@Tlcazea6>PA*V*#P8G=!(pA2$ ze4Ac=P7HF6-=Jq?6X}*yxnInxvhukoxgkdb9^Uct2klJhZYe17uxF&T$IQp95~(MW zWs|jTIKQ1@Z!1IBh)qxwUHD-gm7RobhI7AMdK*eFg+l$8`SNx#8Iz Zn-uN((jXx0C>5YT8>>B*`4&h2{69YpT3-MF literal 32685 zcma&O1yodD_%3`9kfB2mkQ}-sq(cy-Q%V|1>Fy4ZPLUQ6P>>c7=|(`1M!LH@hW@s{ zyZ&q4wZ8j(>&_Bqm@{XeGdte>ywCHzM7&a#!Nz!k0YMP9oUEi81U>i+K}d_R2jHEv zeOXiRgzhM-;{riA9shoix*fimK@c@0Cn>Js`Du5~!asGlGK}?{v>N-jzWQvK0y`+_imc6=zoZcD)>{pe96n> z5SEiC6X$<_dyy}U2&43dneOg~gNp_Z{5m1HQ4zc4u^1pfIsaR%Ma*HiJO1Axm=n24EpGQF-EHrpH^vxX}I>tz^ zlo|ck_HWR(&q0$#+VK5RT)?Z38wRN0{Y8zeiQnvS_|oB02O19f(9T&$7%q5tcu0by zFA7$?&?(_xUNP-A9Ef_z{OdVa!$U_h@O&r{zxeNW4it3C|NYn1gv?!N^K-FQx&Q6i z1U5D{7$x7uAT%REWGL{$$t-wqV8F2It&*~GtVE8il2WFSTM;sugIuKr+K83X4382S zsr2%uRAeLiFHRb9quFMSbnR$cb9IT)aH89~!ODdyw?_L?I2<p^L8UhDP0y?Sa; z|Kt02$Ge+LCnqPrt5YYV>(`D3*mtyfrWlXX^P|5%w%%dFcqCEh?q>AoM#%S6{zB)Qn-&FG~(_;7 z!b``G&JASP+$t^coik3=dPRa(s|4*EWLewKF7Zq zmDYl(d3bnIfBrJ5$eZ`j{b@QK%3tWdC{`;R?`}-eIeSw=5Yj_Mc5eI*Y3E064iZ1# zVwZPOPEc8C{&7`An~@uxfvyDUDeRIOL0COdB_=UoarYGEK0+6{<(mQ4qweQbP2OkQ zVO0Lwy1J2ES%NP4mlVEMR#w*5MOHrRf6_Rb5xFn@KfOvlhdBdx1FLPHYh_OKIYB$3n z&7*tXDa?BP(U+pgB9@Jj@+I|ddS9T<9{Ma!%&yN#@0q6f zb}FyAvT_72mSBDNS(A={R9D0s^(~>4*S@f4ce?wVqJ)+4yTg|+O-DD4UoLp=>om1% z5#rHpkCq>GVUN60Nl701`s?(}W^775B>#PnrK#-$suU)s+gXYRVdH4QSnl+O7s2b= z$sojeH&Hg5yW>fm#!~L1pf~g4C>$Ca8#~weUhK~?GczY8B^4-VrVBXb<~>1ct;knN z6Y=Xc%g~f$*f3eCoAeC9)6{!OyvF_h^22S*XTOHaA;&U36;n0bk!tSeP%Ev#F~v<1 ztJd8`%l+EMhQikod|K&0SccL(^FXWT^%r@f;PpgNbn%yYp zqUKQ*sdC8p?I-=4izc|F-YXjN8R&<@@Z0}(**}k&ON>z5KbD=7W=U$NXr%a`K#EAN zmZnJ%SiuoxV(O{D_QsZBK6Ej|>5W*vuO_pPtuAI4!dd3$j4IdIT`o%BKprFtH0s(X|>$%VM`QG{* zQ}xxKG76IllK&3xHT*(x2zAqC5KjCpUtnz$u4unIH8bh)d2!=lS6~kIzqR4OewE0m zqPxFNL`3xQW2cNv12g%M6n@0mWL`>z3`bFJaDV+kmKd#&-=`>*XQxzuWTYE}g+LH( zMWG@g(Ka-kFX_bf7D1}P4}N#n*5=uY$H4kdu7T#-|2Y-8HMzjpy56i zwWgY(=325WWQk2hQbHzd=%d2Yu6;EsJvH%W#GHN~2Ll?a_ME5i1$P7{m(6?(3@f~} z@biuhYO?vgHYMc`NiMdI6T+=8iIxNjwSR>orK5lK*`_n_yu*_qp-q6nC7B{Q+1g1e z*xEm?^?u){4+*h4sEcD~AD z4E!7jp>R*lJy0P>i^G1})pu7h8)&5o779(LhUbaVJ0whzWq}fY>iO^(@{t|pca)^3 z+T|S&kt_A-vWU<{n>#184mH*8f|lclq$^Up2fQ7mG_|4v#3cV}kX_;OML&@dDUEv` z{jLVLtE~pTtF0kbhQaeu(T~YSY%ra(QWrBN%JY8c&W;6ED`}WMDr*s+`$G`;aW z7wz-QP6BZ@@u&Hp9^s4Uj&5NbJ4y*^s&<)urIm=+Zhv3wnG~v37%_&Q$Hm2Wy509a zQ~~#n<$Bv?4>=Aa=&%7DS|kM9{|gwLF8S3R(kFd5ox2RoI4_~7=yO!m=JEpuellY= z1e)WplfJD)w?o7G_*Z)&*PYh^Nq)EQ?ML3}D>l-y1K5xrBy(zjDw10>IG}%8TNuI4 z{sr?SE!S5PRzB|N6rnFkmn(Gs)37{|a#}_+d8bQ>^L&3HCtv>oDOgge1GDYWYOPRGQ-Jdc=@ng|^9VmhJ9%)otE!C&6AV`tphleT%IO3hA}y zi&!+s6Az%)*=Oo%2U&_*TF)lRD~SgyC)hoh`qe-BPr@XPf6r&ivhXsvd$@K&fn|Ls zZ!3{o_Yi^9x8D<#F2p*mXr`hp%=May4VnYJ%AVU9mryw~7DRloT~OS3D=ef2y_i5n zrwnwb!N|_A5~ca@JV3Y74^z`{JS&uw4~yz4%0q>k+ZQQ%gPm9qw1*5niUY@>x}~74 zE>ws0$zRwKQ;9`7w2(c?v6`DCq)AZ-K!g?*x=VioH}jA{1j3<4pl&kEI*@RN4E+9R ze;vg9r(y0fjCCZ2G>(aF?v#SBzaH$F6c9jYXl;{|&vp2nFjNuYxclaV+0Ani7ZHm2 zWWtma6LRPK?rPDXRb(y8=bG;c#8kjd88VGL=w;#J%3lc ztZkle?1R%enet>o{akRjb>L9}r>(dEt8&S-7t4c0pXb9cMD&>wawEF=E@hb^)+qEy7kI}ydm z5*{W)&jggjzE^9fKWwPn~XL7#S+G z*%E(STU*bPsadQKy9_@{w!7#&K*U9qR}2SwQaX`8d&2xKizH^!@^gCn_n+vzW86Yd znb}QjinOz2VECc(g zsSNm;yS==>2~3;ezDWPch~;aE5o=QZ#!uFZzM-(QXw8jrLX%f>&&yvW)qzB!r-zJq zPyh6IGv%-UwtFW!bSO{xX)&UFWL73kmQFhd4@HaP(~6wgGZRjje#2Y66EjH@)1#W? zfc5ZSCR9|}+mRR=22xs@ul{P*=0^V>1d&*pkRIjzAxkwELl%>-y)cwM97D+{SgYmh z80Ww1Dau9;KRuc{Q*GW(LF=y&`Or0Xi_V;HhoRo(kG%E4r2YrVrLLI5q>tZ0{5N?1 zZY*B*Ip3$2m13}s?z$1r!XzN zG()%w8OzlcmXU9SZu@Iw`9raj$*0RFTcV;fK4W4DX*w@etfDd59#o*@klr2+Bd#4B z6VI~Ex7M~2eN^}k9$KNb!<86yA6SpTYq(PG`!JWF5-s$-z!ia)*IIaAd;jw#42HLgQIrGY=fkUO z*EcLEJxN07QWkz>vPoYgB7zoGKnSj-m!x}kPG+_%96vBflqp6px&I*GNidewdD>_kkZI6ql^P<^LB6lT3l*6)$G5iG;)+JcFXe8hU8F#ki27&_8lnsiFdF^QvaP08*o(0> zn2~yFQzOJxD#;d2Di(sikkYJzXK(ci8DAk>A3lE(RY%7~$JHb<*QjUs#;~|l38q}z z9|c$zZV^6*ga12?V)dw4bOZ8jQ`*T|Rn3ue;a zQ<}b92y*quNzAljAxYuc_uN1FK*k?7XjlI|B7c($-Bid`5P}Yt6XG^&92S}ZACRe> z0{8%*bK7LQK@xL_Jh*4IK0>{AQ(%ijOg$!MdUz!svHnp3CC84mMVFHNtHuTTRuG;% z=~W6brZPw0wD0kCqmR$*4&zaOVgG{T-o`7hp|Q>*82o9$HSY#Y;@g*;o6s``+w57wMw+%39^J3QfPYT_RrG(7;!opIFR2wtrx^;uGh6Zux)mA%5gpM z2sd^!J;3)(I=H>d4#>Qj-A*NaUQqI+2C$<`?*Q??8ArGx^B)6;J z4NVEzIz=do0~H;DPdwOzYtRSnjjF1#rkdt|p!GWq0+r{vPzK7w2>&_F>@;KBok3=r zq%G-LDJ`uC_Ux9V^D{p*qs-VQ$MGLND_z)`$`iw%ks!lfz?B3dA+ve#K2egCEJjX1 za^#{(q@wm-q%v=R~Fq`m%9ht#id zWh(x&buv+31R9m^;vy!Px0ry6Qb=KsiHqa6E7m9itQ6k*1(bRvtp0#DhCh z<-?XZ6hf}co#^k{IE`8%F|pKHWLF_cI%ya@J$d(D%45(^((E8f@Op-8xc;C76PM!L z%VZ$Np_!(+KmQBS4e}*t^=79-S5^}R1uxWE47f$sq~2Km59#UFbqcB<^K{Q&^C(40 z(o9?w?tbF4pGEv4elzy>Zw$!g0D%G+$^5wZxIsIP#}< z-dPqY_Z@GsGc$G??pXcr$i|6~!{W2~nH8cqy9gpW&8d7Mb7Am9eCwDk)!eu^+#5#l zN{=Byc9ud`Ybg}vjh5ELxw!k<`nvsGeRW~s79gW2c`WfHdUzDeR-XEBZAv+u16EA* zdbcWn&t+pEQ`iH1q?!9Hx4gXkK$gS1>gvin&e5Fd4nrq=_&odSiu0p zv0gHd5WG7tpAO7Hy_Bm0gNJVW$#i0e)PMbw#lw?YBO=n&(CpXy z@#RY+IXnaf$wfMCr2I{bKMocdw5S9!)|PAgs;TG1Y}%YI>x!Q1$o2+qZf<=9-3*A& zpQ&B$-A$d})Kdp2dM6+FJ&Mq_77aBf3Bh~TR4OC;en`EaOinr+fgnL$+M1Y0SPfE! z#FtBO`3|*qrfP@464M?(dF+4CbOCmQ@BawN--(Q+@{y5|^=>=s$wq;UPlQ}I&vqvI z8?38^n3;bUim8g(wBETNu$i^ z%TO#qz#b+))dRH8oX3J4Zv_QZ^T2er%0h+s{?+Ywd{_TiM9n*;LiK*u0eDDAU?ACo zKdnxU;SU@B%uFR;U&JH{0de8|P97{rreOBIBbH+Qoeu-Uxr#EM9oce21;|NK2FV`c zdK>}3DkL_jXWPY~tyHGOsW>1S#>Qv*`t|Gc^$dsR<6hR+0n)GBsw>@W5JQf)-<;0% z;_r^RM|P?&o(FQ?tqm>3O_Z^g7d@G+8O-2l#CuF&E3}?OA3(K7>m>mH=`?`J*S#qC z7%Q;~_i={RBdkOh5Ktv?Uu;ZFPS)DZ{B$0T=feyhQQ>zNNzCqB-I#I^7c+vn<;DJP zjK!P`G)D4w_B8rVb`)i0U9Hj8?aqJh8wlae4rKU-ar&g*I|cRp?Yr+Pk<($rM{L8AMwyBTljMal#4eQTCpb^tmH z%#E1?WCz*(C@gP=mHJFma0`D<&KJg!p?X43G~7VpEtzOQ1(}rV>zj$(mM3QG{cRT9 zz0^Vzlk)Yg`$lr!`@U51H*t!8?JIxHzOAvy?;leWT+sgDsH4z^xTj>_ws|g&CA8lcaM}(=V3bBfq&r*mWtymq3ZgD74#!?o!i6hk*g68_oh)x zOMNb{_fZ^=p+)(Bm*!siEG)S(IJEYaB&RT9#g4M7YJHhyu1?B7Z+*U|S7h(z1o^G~ zVB=JRzrl8|rPnvt75;}p#?yH!+v7W;!skm!brVV zax|z%YXJ(kQf8lZqkchMr z?$uJV42=snDL0S^!HS`r{_J4+Y}U8B<>G1{uKH4OiUQ74J*Z*02(lE%0aPSN2o+%4 z+HB(?PKi-ij*wr|npiAAM92;zn$E`hyG#W6j}4lQEF{R-8Ip@ibNb|!H?qeOHiRbc z3q_hlo^#O+`)YrunS8UJt(vg3+V=peeI$~L)_MzLUDmX|tN$<4IJU#}6%;X9+&aaS z4ia`p{ON^$VPbF@=yrz9WDSLCNl{m<9u6P4>rWlstzPu6xlIebi6~!7kdLU$FYF?n zcmQqEfu%ge3^TUg7Mf2$1XpOiaWQsw9I5{E=lZQ!&|PrZR}1#WR4-~#cLi5l8+1z5 zv9niGD;xJ-4sqz*XoEjW+P+N%AEDsy-q5ciLH0mG3RDhyMcC!3NHpGSih2*ZTrMGYrqre(aY%-C7ejapb*1a{LB?W>Kdt5)WFzjv9XaS62cB2qsqZ^ zrSCm7y-hl8qVm;qXVaiGdm?l{wvTGj%l?%7eEIi>lY(zTs&n)mZ5-XRf(8s9;302u zvMzsBaO9U~-1Sas$#2Ui@9FTF4q=gi0O$dt;0p^l-qO**I(5h^dWkd`oF{MNqYT4b zjp>4a2%b>TE5Q%viN2b3J1%*A&lJ2=jyqExKDQUT(BCqb=vj!ny&hcmpL44mtW9kt z35i!Lnia7)3C<=KX;{*!(-yVqDS5v_T#wj>AoftX9aHPfFF^ZPvXiGHcrUROo!k_v z$iPj4Mc!Q}9Iq_T_V^ls(9qJte5~?w?txA9F>i5g=YHtjJ4N~h+o`LA`@8a@{I^C2 z^9Rj$0Y}5biiWX>L(#dW#LHIdjF|9&ER$!WPqKZIIB~9N4Ox<$B^ecq|HlhJZo%`j z`J2H+S7nJ>VM$@((q7s9OcK!6B*G2LftoHZ{<8%Yng`Rl4zKXk+Nful*JiuO{;o~P zuXpv4*!@SZ)5B1eyGK+MF?h=~c@c_WNJn&O^8bohT)l)igpiRkt z%VJAk3lZSBt1+6SP)Zq8u}DUJc_6ePW5GoADL++M<%dgwdASgr`o-ai=?FV*2te+q zXA^H4sBMAV`rzNZbq&{##WQ(UmM1I&@9lcCl$+UL=J1FAU}T~^3Wt1=?@s$ZJ1$(p zo@JHB6wq;;jUSOd7YBoIB*a`|mwQsFmpnRA&dOHVKYC{VUWl~L?lXY19Y)@6Y`{ZON93C2nfWx(%0;PoO<} zh%5oar6P~fl{?ehr@mZ|K1hgpGX zNA^Yk^i&l}Qt$fFbjmux*OAJQxbS@YvEih(0c=8O=yK8%t;P59m`^2-X&a2HgHAKZ zN1p2a1hX4td{R-5+Y%o^LOno4+B|g<;!jlAwP%6f-JNComw4`B3q7AZmfdq1w9fXN z-F7uBW#H*B`*I`>XOAR-h6E>N4>2FJg-1nI1?U%^89OW4;3)OJ_0cg0+eMni(;{{t>w8VF zsi_Ie0iF~U(aSGoW%~{R*Ls$go0Ao$|J~%y_}nL-odg-mt%VjbXPh*}^)Jay$T!yZ z>Wr6U!>8T~EJ^8NBR7k}L-Pi^n+@N`&cpOK$JGT~)IzwdkF2BdBk(&o(}O{88DB4*2i3{}yL^t&{cD!GfJFe1L(2DG&bcwQ^6EZW%E7?beAy?FxVUIk8}zVME?lFF{@m!Y43CCEK!>(2V<2 zsFihYz9Bv`665QLyBI}eu5=t_lX+iqet!Ok4?EI4{Jkeb+ zMa~D9UMEvz^^XhFI{LN`G<9Ohwo7}vvB<6_!YB!EkW;a=Js$?Lcb?N;ft*#(jygmj zw!!mg8CYBNY;4YVr>FvMj!JZ@R-G>qM=LU5{SUoD+GHUhAei^Rwkwt}ECr}KZD*o3 zoGHWNDBaR|nJFW~PIli^N7VQa$e%ryurl0Hk3@2<7~f+4E=;rUpk-@Glov zRZ%L^l^a;_$IL4<6rc1 z+}Y{LBRErt>=#9M27pcKVLk_o@CM|eLcEGpmFP-26IM*R zX@T}4#TZEFyu5C+wN5AN{R&D-)m{VVdo!8jL{KZ=OXoLJNl~s=TvTQDItl=?4sq7$ z@Hre^hQron88r215tqVZYEWRtlo)#sqcr)-G1gz0rmY2IR<1hVH*NUHzI2xSSrCve)5WU#r>DjjAyBLk#QoS&H25bRQN{(`0AgHDyWijA-ucon4q~$TPH5g8F#Z87} z`Lq(Oju&L;l*YE+@<60RF}5}MIzBW-3R7}a`UXKB6&K<26BESAq9~uabFEA-%=m;K zRaZKa5>td#>lQWsFefS>0r|W}(h9K~3gpUiPH^)`MdYXrjjEQ75Na)5@y31OO`&e- zvqvh*6WwEGTNXp=;F$1f3tY z!F^>(5|aj`rqaD1o3cMk|J^VC?%=z(yb4J&E{=I6H}<>GI;Pi9pzvhFyA7{9V5L%! zm!}DF{I6qMamuvB>TB_As`+d#dq_%b)|i`gfosIHY2Y`~18Da5JjG3%*xhEO0O+5- z$)*CtA|(Uk=wzN&pROn!Rs_AGcov*zwqCwe+(MbtOR%eRpFM&QT6|c;GmH&=eng{2 zN=!7m9nDYTlFr1yQLq-xA3PF=K#WYKDdXZpi=yWQjbDh^F>xRxs);;e0|U9glif7{w=3IQ|bchJqwb=p}Q=Pg0TGut7Fo;b|(%fPivq+ADDT)Npmf`mKd>il*Tx|~LDPy2Q zLpY)PziV@XikND2`fPFw>vgxKOEm?JNkj!gDtKQ3E{wvSqpjfUR~?*iG^mz>ibBEH zcanVO`8ooIokPmNF(IAA63o)`OIlk82i)2L{%xbz37ZEiD=QE$?oLNlgazrK*1gur z)Um`SPaJIWNZp%TC6d=LEmc&nZ(47PSw!_|g?u8}|E!oS8xXNVt!}&Y2;kYts9}!8 zKu6c9b6zuzd%k`H=4egO&ai^(m4Lc_t5vSun04;2?zqLShcsH+$(VO{k}O|cD*v%M zNuYsuXt?z(SkQ~>qnstMiZc`c$_K|0QptdUuFxBNOGI+Ags-TaJkP880Mf@~s7Gog zbDT@uYJXtMIr;680%C|$NUX*jyZp8K-z1GpH)4^0Lzl4Vu|GStZq?wv=Pbbq1-d_T zRq1-5vavQcwo$btyueFHSN#ltKwPn9;VWr1KQ^kLD|;Er%EZRbBFz7pm7d5dqf$RnO|rXH#GsN}TdU#Zd_JJ$>4LXJrbAL}hTx z?#l!|pPL#|8*NQ5R+FnG%&=UJ$kzqhd9KG#K+yks0%C0Wcr6QvrK|wZ`CRO~`H@3` zI5cX^R74%CYmEx-tVGZK_K$X@S%ks^Wa!7El(EF3!hCDHKb(WbyfD-Jp(_SMm^wT? z-{mvMb7;Q9F!)Waqp`pL-BguDKfQXs;?z&OjFUXzM4%$hmeo%FUE}mfrPBm15MrOO zh~5DchjTK6^EwTK7XZTzoQjj>Z^T^WfG4b~a?!yT65?(D4$wyC=(JItY<&p|SQbGZ%L!i*Syp0nJ9uj)l zrDuEvi;$#QCZgzfEN>n=D_-vMUZ%1%AbJ!xkVT;N5q-F#zc(-U=yLSKF#()m{%r$hWGmP+dEjB8bvAB?PF&TLWA(818WnL<%ma&YziQp4;5>1FovN(n@n)ggz#Si zGhIFW%Nr`bNww4y^&*@ka$f{kJBW^upihG!CKs1C3xOq-pU)67v_IESV>@+xxsm;E z_oBE-pa^(4M9?)U2jFyievC9N8m`gaGZHLAm+SW{1YkFRS?;< zURz*5{-1NTN<1=GAeQ^5=TBTk6!CcZuMgh^ZFqTfkH{HEqr-9TrS?`b*1BqK>9 zw9tj}18j5n5xVDJH#G6X@krRv0zE7nTCkKxkB*MycVcmID4mOOLRi)&#^C%H6YK4TI9pr&VQYR;jbLvqLWk z`?I?K3vmoIo!e(3Q0od<-vBF>#UVqBj{5o!jJ3h$FjQRbrWqm~&1In9O7C97wxMYa zSl;^FXk2s`V}K>Ps}dF`$_#dnIUy)kh9o&IBJafIRTN5GCjqc{v9te>Ka{YnwHnX` zNw#M_pJDMMiGMz8V49~6`H+~{9YYqj)J6eib)-%z)ze~6EKrL!zt#-a?a;3a_lg|~ zxTB=z=|Bs6<~0=x?=T=^hFaS|?7q4AC-YG4Wn?8i0XXrmHv zTuf9Em6Ml$w#PtE?{{<5eSLA@AqS#)_acGMtE8l-6M-@$C)==m>cJxI!wW_==1k1I zC8R@JfC~_B0KtUY)R(3`_4lBi&aYxxr&QHx;Wg` zDX7Ay(p<1S@&yUE*OYXI&0pX^3W`B-s9V&Qmyh)F0on9xAo9e4nIUuSK8jlRI&U6d zLO(>>b%|{~I>h*%jYt9I9ui{21h^urPdfPisGG`w3Jq%Y3RfH`rb+cBL(kH(8Jbde zmE$UiuzpQR*#<0q;x9C2SYLy_fFrga4ADDA%z@2d)`Z!+9=JupYWBg<_L^`j;oPMIXs6Bl~RTK49mYFN(yC`y7Q) z@;G(r-AnYo$~qlyB1K!&R=b(+#vRe5+|#~=&%t8v?UiSIy7cw{#~*lXZ?DdTT{nk- z^!-Xt&*ymcw^9b*k;p+bK#9syAN_qDVFvLtm62LDj_S0UTB9W&b3=w48HgYD1+g2? zH+qq*w7o;qd;Iq8TQ$P>T%!IrwG9t;U_R*nzdz7NJ$?$5$#}Iw{RVeCY3Z)nI+sTT z1pktN)}UI1y{jsGz0`pj;mDgqN~W@2?mu)emZ=o4o&-jiO! zpNfapbg<~s41cIGE<1bS9j<8Y+x{n`Wo<^kousHnKV z*$_jA=d)yOEO@TOfZX}L#L>`8T+P?7b+c-L*gfCmqd@mzb8|Dr(7O;64xwrRAPQu7 zaXdT;I2?X?c?pAu8b2W;Gr)TcwJsszUx{zY5bF*qMd2-LJ}Jt@(sQjAhoOtgFRv(U znANkqfM$2M3bOA&Jq_8DCwLMW{0_;obdMMmzl$tpgPR%os<7aHy$6EHpKP&!;asWW z*QL)iL8Sx$m14KR@9hV=35-C??fJ}l)!hj=XW{;Kfy|-N>1_M2L-XZ2;6JJ?2Ho4% zCKV2W^Is_7PDH}8GaO$bnN84fvDK!$DIW~bzq=&`T2($Z)veQ@aaS>KI9`3{)p{1L z7PlbSjyGAPqe*gxEt_x8^+JZyd2K+Yz{}Aeb;)>@fLzmh<97z;y^5@?=XPO%q4(BT zz)cau>0s@VM6C0mBY`QL1N3fr)A{s2MOG+klTaYM4MgZ zax?|YV_VPozZJ=&yqGuyy%TUgWwEuj1xN+IMVq{hPiuNGI$d5TZJmj_*0IcEl z<)td;4k|<$rDX$1mDLS0iT2WBjen~0nNi&C$a_MUFobdzKhb(&Pv4K><5@&0Ku!R{jOmNwHfj)a61KL=tb;jdrx z&o23r!$6SJF0OvUCZqith7mMz_<85>k=3i)(@6$5)SR}iF7EY#l`XXAPfygWQu z6hay_38$OGreI9gV^0A#F>!P}Y`Hrt#}!2cnomtmPJ&&xVNrt9YB+mbv0yafmq}PT zt_`oy5FA|Me=j=I#`?|+*xl~#g8KSt9-grVxqxX|&DWNU$`vdY<%R^A!hd<}9vVvp zBoolwFOj`G@E;42`>*gXrE6PIJ6V$@3DAC=a~3vq1n6+d1rzZQoM4~f@gG;p2IUj1 zgcu}eIDr>jUG%EJklE&4gl$+V9{eKZBMM|aH^UQ2^*M!*pp0gqUpGm`q=@<%L>rb9CY75d&bPaz_)dA!yK1fM_s{k+;G zwCF&aIh1T{?QVJGpi|jxvAuXa!a~)>?a5Wa)di)NreRbW4v~4gBKqBKH^I$46 zx9+Bok)pLV@a2KAtiornf8MQLX>~VS`?JNVR#ot!;FI_vi%8w(W4p>Z$>>ry%U_zR z{P6o^13)F%?{t1x4!6I@>}YQvFEbz`C%?JcDc37YMurZlNmiCBI-V-f9sN~Qe*3Bg zi6;GN$-Rp|nW#uG`%gomWJyVQblNPNX*Lq@6&w1P?5%z1%SS2yUqUz9#D7A!aswem z9#O`W$I^GX81J5CsIH`|NcNW$Y`g$*FZiBdON8fJWh%>zo`N24@Hl98-BJ^_Ft@O1 z0Zt)M1_pMCPw(CV%uYz0(qkyZQRqNIIBwyvuNnm7f72mjnHtSg^z-#$mFx&X1RmiZ zGm9tJSe#9P{1nl6@>p_;94h=&+W+Irb=>*|4IxPw#ru!do@cTOT?!i*ZcloWw;M7F zC&-$mrwG&0(TRys!8~g$BS~iN@hQ81b7D_eDsVZ~ zf6U37Yo+$FLC~+JFoae_LiUx+h}Tr=2LGqI7wWDYnjGqT|D&nbUSb)IzE|RrijyN* zImUbd-2m>0<-LJfE2sTzlDT>#AKzSE#Wnb`2v zjXp8GWXUTToS5i*%#&`F)KmSImb(>1L4iEGVst~F%CcTyxxdS5M*QM8;3>hExVT41 zmV^9R3hvr*X_u`um2!VQ+L4X(8YN>oP0(|lxVt&E+5U>v^bK<%tIki0sc3O-BRmm6 z3o6*4k1AW?J&+^kUj(?os00KNo2{1Cw( zr-Fo}gmm~!)rFs) zUMK0RX6^m znR>HP;o%t-kDSd08D!&3y zNI!iqos03;=K%aEEd2fZcfxNoSPsCS8|&-9D=_{R6JX7MIW9;DUY8sC>4{Cd2a5p< zVH&r^c!|!*-SxpesAmQK(h=@K5pMfg0pS29gC_6lFJD$Gx+!16w$6Z;RaJEu6my5A zGkS)+GB;ndd+*5#gM&XFQ2bY@(Y!o}i;o2Bd;SX>0Qj`o_S0K3PtcpyURhdN)179w z;7xYOOy2v+03qEy=4F_3d9$se@_KN`8i|XQ7CR`gGwZ=ajHFet*~lNRpLqrnNxv8#e*e1{j~1C%oIS!uy_pyqLkqgIa%qngmIh=GBIP=kNM6 z(ZLp@fqfYK9O1O}61U37AMDC_gq>y<_3&3vV^1GP%MIwL8LHG!JYA6Psi}>$1|iQJ z(N3pE&3AWiq*-JM0+tIzwxC2 zDV%R0#I5ji8975nKAF9Px4Mz#!$7};!JfgxL-*R8tg^Dkxqz{l>GRv#AY?Qg(r2q; z_m^>*rq(t#DNps@2JDjx|GThaIpF`ivo>^+?M{ps-SUt@?qIB4&qReE%=y@1ZhG3d zwnXu?kE82j11L9nHQ|$j)R?h(W5vL@<330b{PHsJ^Z9Kjm@08pVt0UqaM%k3E?Civ zSr<5b?~_S+49XjI^(s)i&TBIclH5{{gL#mued0nM4?t-xMqFQCqdxqDuzwVAD1aXU zrV~?0mPC)WZg~M-k(8`y#^WsD+b$md$1Zh$LVkvCThI~ryusfDQuj*|-NMO+60KF~(&Jcj?!*LwoK`-+< zS;wY&wpv<{B^fFr&XVUQ6g?F4IBX5B@gC30aupM^uq(eIk2d=Uuk}L+mmYCRD|YYx zX>uQkhPsWOPJsI`7jvxwe<;B0?c31z@8Kbe<=g-K&Wo)FXjnKD*_vszGM= z97;syzOt!NFHu`pNMfWjl`W><>Wn)Fr`_FNjbS9O{^zC4l z9i@Ja=aEU1;e8w0PvPz#UG9txwY9Z#4IUO|W{qG4fV^oFqqY{MzKFmksz5G zd?SB@9xSSkjEw9OpYKczI{TLb4d$mvv!BEA3<(1ov`G`*9)^qaHR>2&LaDrE{B->R zoM%j*H6(27zNwe<_W!BuucNBo+W1j)AuR|8gaGtf_-yP%LanCqo9RJvxy=B2S=6vQeKQ$E{u_iJch zSPHZL+neVP?TNuVq`*M%kN}hYQ(m+xuJgB(B65E{{wV1Mb9cxOn25~+Om>jnFbc$e zNl8g>uN+dtcG42_;ghLD=`Gaw0xQZ>bbFf52oHYA>;8?vX+kIofK0D6h z@89%40+ngFi~X*ZR;*1E6B7e~DF6wMMX5~Dc%Q=rniD3i(G9hF=!VcJpc`rs9vi#a zZBjb=7dR^s@(1o&#^A9Dk?S`y7WTs=m)|>Txpkys?K~aytF^?>)-+*k=>MB{0KC$c zG4`o(HvlS>K#vtvWow9!IO#Vy`>9((U!|k{$&=~Mm*yDwuY4z`3D?nctzm?dL+A@@ zIqEfZ0A!(W0U)OG^89j2qQZ0_NmH{@@U9Rdg(IHVaTU@9l>56VQ4l(e+}v;X z7MfOdS-9UZvbOa#Zusj9pO#`p7u#9dVRIg8(tSGXN{!Isx>@JC+X1^s>TSr*g zb~Gl!julWoSRaAh|Iv8GCu-L0k9~D@1pt*h^dLGU4-r2F;Yx-wN`pU}=&pHs!pLFi zu9N{bE#e*p%*I=nnA*=^rwqj~T}S!83H5gP!^mrna^=5GRa{jRDB${89t4AY$NflRa+z zmqnffZ^K<}?{{U|_rMeHT26esEvce74a(}PHN%7Zfk076zkF$`DW`)!_*kkK`{oZ5 zMi!08o?`4)BO{gx&54&%MvUFrYVT`rp!xRm%Irbs2+(KN%2A1N&!PLJuFI^dy6I)* zEkr}0eyg6el|-y+F)2ww5$Q;(j+_*AsNc#WN?m9=+BIBnNSYKD13kU#PW9SO>At{MLX#{>4 z02DQ9oHk&Uudtq8Eu2LBG;IB?A}ZBUd#Ge3psX%?U%Q}t#a}%0H2EbvVhqV0JHST?NDpTzrAfW6F;Zn|r(q*m z5sxa^>YyuG3k{*Jej<#pYaQyWWH)SwMjmoh{DXqDWlZ`Laz-|02=5_WV~Fn;tpAG% zeab+49JgPErYiDWS(ipaw^S|QUUFw5Pj^J5l(hQ^kXhVLPm#eHkl6FSX>bPlhZHsg z#QszCDDD`cgx?OW+=7}MQWrxddz_f?ag@vW@D7GiT`^x^H>9O4&3WwJ!onKdaJu?a z#ms})W0Fpmqfj5ZwT|lBSgZ~va7_Ve!hlQ`<-zBYNf{%(gv+N`=7tQ7Hn34K_2z1+s6_nl`)AXH z-1dKG%EyoYc%A&^OB0)%_SyN-mM#Un8FXH1IlP-NlRlSygbUTV!CMtxKu>g(V;xYM zb*(?q;AI_;+wUs68k|NSrD}>u!GsI0{??IU8U0S($=kt> z&C%K~nazDPdbhsz?a}6wqoZenJYL8R1O6REp+m%i(DgsZ$~JH%$;v6Hu8^f{T1eTg zbFCEDSAFXUq5ksLJTfdKvQdR;10Zg~z2)G9;2Vut&lF5gmj@>|%t@zW6=G4Qfp0Q^I%_Y3wi;|1EL zeR1V)nrh8}d20N^KYf}7_tphkBP_g=lNy*oPHm8P!}r4} zanu5K#mUHDs#P#<#cf!XE+{YnefKjiF5b)O4%2m|;hf~Rl{(eK4Fdv{;$$RZ{Yl)J z##&>h2Fqh~VdV+*p9u+P?`Evok>0&`Z*p{$TKa32;a??-axF#TZ(XBqV_Ub!_1$TT z){Tl|A)G8KA_9msNyP|gIvZi+1B>xi+YYfH_&dVs?Fn9HjZ$cX$<71zhP&4X;VQDF zX$O|CStP_6w3uCTi-Mq~vR$TcV$~`O){jBL&Ohq*Z&FgTvDpD#=8C`{6l-h0ok*dq zXp^|GOz5`%*dtZ0bKOhcE0l2g+oW>9@2F{yPF;7zkEQh=VVN7S7a5nViii{ka zm=L-=93hsdM%EiDVj7yPNev9WzMk8Pz35vaPW}Y!>>(ChY{oP;!FY&#r~Ohb#Ry~? z*9Snsk&FNJm4_2K%6b>vNN#nAP1(*iRr`qni|XxfLp9#6-_yn%ve=ey`C{_aNW4~4 zdkgLP+S=L+aq*bGRZtJWF3jdv8Ft~S5?(*@T^Wr5&lY@PmVHZ$RNPl zM(dPNqwwFtR?(tU;ZLBLEE)T8yV{@<4GYoea2W3n!Vs8`e2M)fv5}ES{rtNh$@s^~ z>`{Ex36F9-cTOUv^0QU`^uY2~xPV22)m{Gn>q^QSULJozd%1PCFg%1#_YjGvogLf2 z!5>-R-N6y91AUY$D?4vw=Tl`(ecdF;<_oDdGqllSX9y7V3AC_wmi0y0MW&cFo4ZBP#}H%{ddq72UErT9@&w)Kop%eWB%*LIcAX?zISgc538V`(MnKG z;Kh*;x!Y&mWRO;gv24&FE>H^%RV2BCg~}&qii2Pok!~CZpY8O%Xn`64j(z?Fz0NlW zTSCq`$5N9wep&Delz3Gqd=@7Yl6jpQVX#zyFDCmnu`&?B| zFClz)L_=j?jXpRQjXnE?#v0(y$R|{hUuNhR?M}mh>1}`$9&h_#xm^myowJt$8!-`* z*+wm>JhW)fFA?$=dpqFZd&@_Sn>{l2^;OGfWG*PaA9()nTOswesGo?R9@6KWHL34x ztjbuzUs6dD=_-%?C1B?bu&Em^z7RxI1^=%f(oCuX=12f`;9&W^&XA41!=$l*Y-nUd zx)}WR`HnN9snUbvDtVVb5fkN^mCb}0BA+!WEhvJ9KYqj&?F3^etz1lz)5b7h9$=#E zLv|(6O0MO741Wp>AE`Txw-=n|jf^Ly6zTB!YQsh2wn%*y$C@g)oT##2#-jZ4a zxy{X6h`N}VukAXy-+O7d_FIi|%g0uA-5E4rmRCGAWw&Pb<%iEsO-aD00w2$KA{E2`9a!|KIEY$!0`G}XPZrRXPRM9|`O535|B*=}OCQ(pb zj_XI8_2hurqJHxNJ`hU56uO0JW#6|kO9Ti8o?>U#xXV?KE1Ms)iw}b?i`)8 zXTk9NonTZD%3nm`Dt!}_V)@voG>nWEzdQ39%d=i4Uk%H$R@1N{_TDNv<)@8J?Z_s7 zZjDH!Yh+R#ONxmTd2Rki#yZ0XVMqP~8wtCxK6%p9(_{IhdM(ML!fI;iJR6b1pF$7w zv%K6dAtFXDwy#%Wiv{AJ7@le!f48Iwu@S5k0 zh;?#tuLol@;?FoWB4tw-9fT3;4*l)y#55V-?b{?&@|wsfZyc&X4-JJyPEPKE@LQMB zQ%!sibYF5%+^XHHxU4(;%Cy_lGo4gh`;_M+3u`%V!Kaj$G@*W)f1sWyvYwZfm4RxW zj)tZ@66P^bVbe#7D8eTxc8oddRN88chZ`@ja`J3r_Se(VC9;@2gsLrFdj&XQZK#_%U(4OmPhvn6SgF z;fJ1cmoC$oEt)Z8h|}Yo;#c%MyN!;O0imVo`lpyU1!+QUrx|AU8;3j9UU_}J8ie!QDW)j zZj~tIz^Jen417Wiv*BbtuP>3^P}0U`2g(65)&L9=01;wV zUVtj#kw5*_m68#sw%YlxTvg|zBkL8Pi;mi8(Pk|9(zSs}fmfaDViV(R85My&s6TBD z`J2{OR+#nbT!EF2dbkg-^LLuWhcc}K4?|R68!@@QH;hjdlFJpwOj*=I?Xj)?n#aG8 z9x8Tt^OQsUxhEo>lXu(MS`4E6Zh6pz zcI7yYkkn+hx9bzrWS*D|kc=ET?*tR3&=n^xkVvHd>U-W)5+*r)$wh^p@iU)FsSrx?jKlUGAtH_`9;g zedja6ms~+ge%EDhZF#!#%44hY)~8Q~fwyYiTJ1!!Qt8>H2ks=NVcb%_*S<*~px^de zrEnqmEVKCLfX5>n1cfnw(?I;Qfj)bLunS#=$*YUwR)+n5nj8ghVG%1V@~wWwNK5Mi zPqB9?RH2A2>?W_+3?YMX_#6JF9~#BY|NESTWY0ShE6ot%hqmRicsHX&Tc#YdtZ7{( z*67-4viI?@P%#WG+!3Z5MzkQBEhJLrn8eB8?kJZ%Ctfu`9~-v1`1$d<)1~qF>V65r zPAnm6q0i(1HqS8MxIn6qmE@jVR5Yl`j4JFxnQ2V;?Mt*5mxQN-7^o zNt?;$c9#$+?gUvhu8PE55Bf?$)&>YUJ`6&zqnKM;JF6`t2AQSU?L+&+8TjYzqni)Z zFb&9U|J#;#6$u3dmdZv@HD$*d`NJP1h=#&{4;`0zT7 z9cb39OzfdEdZwFdnP*MTNRvg+7`aKnvV@Y*LW4R34A)CV6*;+&#v^aoJORdvngDbF zbQ=mjFT!9+gDu|%^962?@C!NfH{mO<1J~Tp57MTaN|@wFRGl5A_exiS?hq?w{JuENLk&gTSH<0nWIwfm_?$(T4N4E`^OusFmNZ_wvnXAN6{qH?9uNa?#rPz_oIO(tXI2Wn)k%`q}9huDi zgYZw6m<(|?Q4G9cI9OO_W@ewMyGDv#8OpT^=tH}V9BfKcQ&a!j!f-TwNIL~>N{M1a*Z1T6>ws-qkyup|ht( zJ3qGg1OP=6pMHOD3GZ*+^>2Mid`;xPY{_}Y8T4!Arz;5*C_VO=f14<58NnJ2S{nt$ z(d4T`IuU|i6OOC9DDJcjR7!X_rrRHbiH13HR!yKm@2d~hdYth+Zy)cKWcm|Bv^_5c z*}Z5M-Ctl^NEHi0);4glDJ1e84N@Zeaj}pMubBO(-B!!q4W##(F@x-~{wPH1?~Ftf z_Rc7JzC-+@Rj8GqAR`0k*d5bySVQ6l`L&OfS#%W{X)-1!)Zc1SL&2e$in)EWB!zLPQ? zKb1Z+zjalQy&j(itM`oKE&jmfORi`39pN>M&k?VKARL?}_4G`(`0w$~a1RQKk_wZ$ zQ}f)SgH-mt`486&(VNYk9*A`;2ztC|3hqR7LUO%vg&fhH~H? zXtQtf|?N~fxta#(} z5%PyJr`qDtNXzB?`Rj1ACvN1tXf2fCeUl!JfkhxGLFbzHZpl3qPXZ9ZRz;ECqi#D{ z>Q5?B7wKJ3A1r(S0XkFBYY{oO``T76Z?zFc$S`&m(|&T{iP6C$XYLb50oF{DqBezGI9;H)%;WxjgN+NJn6XNBGnZM#vi$z^0M&8kT;yaWQZAGTr zZ_AaPybWadJeKZ_Syb}ZuSg0itG7_htbL_N@x(%YYslx>miRkCLzlXQX0}yt)G3?{xiJaMKf!BU(b!O+4xQVSyb~W{v%=O^&qQjdalLOOMkt_jUa$FenGu;AaJYzGhQIV4cB8tsF zQx8{qS z$bU4XyuggJebAC5l+Jhht+WMAYspy;fuP_=o)NHqjQs3u@B2V@=W?ebnitLvfv*ZM zcKk0%%z!d(i7tqU8_$b+?YP*Wd zv7Z3&#Dg)(+>EIl{ToiU$S3}mlNpz^U5`Hf;X~3^G5WFOS3{U?D?+SVxyRwn* zc_VM+{%Qh9EN5~Q3j6zb#fU#e%~xiP6x%6jRQ-*b&XJ9bW4-=Ub>Za_0gIYBwy?*4 zp9$@MxgOm@Lhj>}n4R$;-{)i6EC;us?A1(#=?H^mx%Bqpwb1g1<4_XmBsSgf z1@?qJJw2yQK&lPAnBYBpS0UsxyeE;)g-_a^$l_2Gm>=La_$p25Z#937!>+EJlvVu^ zUQLDM$xyAFalkjfqoU5vPVndpfCr^=&V38qbkHq4DNx(mNcowk7&@KhnqT02#n=yh z%fP?@3A8Q+YL?vb5wL>8P`qBVWT5QgDft$suFYMxSKE;FkR_g0jfiW(a9_6uI1 zDtuSVBavW_C3ViLLje>Nxv($XBnLubQDt>8eQLP0cSXTFMOJ??v#BNaz;tqiu6DFU z&9uh)EAhN+y*18ti;w5_7Xjfc6Y|Qg21P1a@;w&R#?-ugSyNOCh!GgL%w(V3@+gy~%zRaMhwmUb}MO^WxlQOk{ zh&JBlf$ZztQSZ}2ivfl13A*wl9tlO*HWh;~1T^FrmxKb%sEON!I@L>u+#p<)Ot+Wl zc`jCy9NTh_C_)T7WThDr)f+VWy((1| zWNu5&%F*X;?TTXGa6DvlT)LNP&QM<&!66>Dd-O2v3Jm{ziG`5me#wbV8JgA`!@dmm zs1hq=m>$qr@LIvuRG)0}=1q#@!^8XJQhUtI{S>j?_6af>4#-Q&Pzp&4{z2}c5w+qr z_lE6J({zh{0#gsm<)=>1b4pb`S_QAqdz%VRl-neFcM@eR0-X|hlL$m{G0qRAYu0(p zZPc0{N4^tVDZ?cs_Iz(oB#NbfPqIL*vZ7+?$47#Fh$n+?sNAayFa>gtZFbS%5ueAK zPJCl_*5??jQG z>D~KhSh&ic`t2nB)tcZ1E{f zee-Q;&Gv!UhjXF%qI$x%(^iG84-DoJ^tpIf;$~3TC!HH9B&6-JfpamoGG=6b8cDL9 zBf8TmBC6;hoI*;@5ERg(zvy6AwY~PkOfW%$SmF$Th&p7n-YU}l48nbPZfZuDZYCf4e_E*wf zdQLHw+=ny!h<~=+9pBq70SVe8)2)YKU|dQ{)<*4B-0bc(l* z#1+j-V+pA8RK(xMp6cMhvQ~#Jao;vR-^-_*ao5*;GP@8GZTo5cQuv}?V5hk)eBSaV z_hIH`lfuKb@Q9Eoe~_K|q%1YSf=h{+Ibujyw^|g3D`H9xjl-C`a`%{(z+u+qxR&Yq zLTBsi*!43Tsj!~8y=OzWOC0}oo;>yoSDpBdhAB8K#D6+($z00=8m`r*7I{P4qc{G7 zNL#Y&UEW870-GkVNC#s}E6M4ofocm1K@@culxtQT3 z9XpomuZwlOq^L&JWB=eZVJt>e;rwF1ojks z%c3WpXnP+M>HtzfiFEE+0TDbb2XkMtVy3M%WE9r?Kf&|AJE`G*YL{X82iX|FbI z8#lYZyUxmr%JsgCZ>Y1~|K4^x;ojBf2n?$xQ*DW&fj3t-dLC*u4VSz(5xP-x5!6EL; z-#q}w*wmeO_DYL6{+=B(KJ9HvD)hyUw9zBz?Q+)4m-kMF=_6w3dxSAvc!(NI%JlGN z`^~=OgX;PC_L*F^-dmhh5*-zi9m8YMRi#-~$^p4V9l!UmM3QOSXy`3IjTmC=A$J4o z+~Qtwf0Hgo*wrTk~AbmozzSAFtw*0;Q> z!z?U-=bmyj4W`z#V8qQ^cM?yJXWv?Xzpfz3&4{(J z_>PNFGbXI1oqY#&c1CJbuIvppZRvOVW2&l}y*!z*iX4sccNq)@B;4{0`Lp;A8Rg}5 z4V3Jh;vEP61kLud*|mtiL4N|huh^6TxKBwt4!uW4LJjIN;9AzKyamww@>1<+yf5>1 z`pRBsA;ne4#m>cPkGysK<;CIsnSsSzZsH8s9(z|z*cob$ha1PUOfX0i-A0!oW@r)@ zf7f}F221=)$Rni^Ij~JN%5~AjNY@UXMwro-h#IX-+_bKxR=l0j=y}p&$^TYUMs1G6 zZG5mv_qu4#H;rBtD}&yjfN^kk>+Dzr>yXpa~ zET<3H73cRmu1ym>@o8dwqz@v=^0>IUT(p)1-Lo=n+^&-!W8i%Z3%)1h@Vh4R$>X}y zDMyv6qu*#lw{Me&e5Y$+c1P?<5Yrf$;M~{L8NwbL@Zg+o{36=idN`-_wZWS3Vn{5= z>S8hI81vS~{5(ZO;{5=-BQ9da8OWCutT9ftPB6M$Ke@&0KE)eI00AV^cqyFTA;{_@_|bK$=H2ps)o^mLJ! z%72e>Oqa+e(nvF1G5jIB=h+9=){a&-TrsRKzi4qvI2QKY&G`=%5IDHswiqDDl^y;a z@eKdl7FA858c+b*t{e%RSKq-V&=e+> za%ZZ3`(Gk$a*t*n{jbdj$u_630;h49)>nTc`*{RVj&G8LVvc_UZ{P(*?jJk!DbIbh z*~#@U*@y%@7)S2eUkq(47^}M`^QY=WO5IRFNC1#kL~7gPcPKpQU}YA@=W<-_1*UpH z=o;dXuxj;SB3UEdYv(Ui#1%N*l;78CvL z`-q1A)nELG%lE`%V-evBZxco7_@A|q2p|s4;IuCIL)Js$<3q`z-Pud)|0+#N^|e9n z6Oa#Ot`aKih~L+S5D`nG#N@Ow#j7g^JFFhIuc7Lr4+7MmSa7BOy+*ltIy!ztlpj;96UTYsB0BW+zFH5%SJdQa(K8FYL-eyt$?h@3?xlpz4(!nV{fnw ze>><5D6Ze5?b+HB2qpr73^2vry}gis9A5eWPDk|JS}H?(t*T0cC2C-hX3W9PUYwub ztN95ICi&@X|BJ&leW>$5;IbzlPpjY<^s-SC5M>QvG?jI5EZ{ykxDt*st(kTo5)=PE zjPk;e9}yTZ%&_pF52f-)Lql`rBiNM~DNCd03D`F057>KY6uv?{Y{r>{_dUx_%TGOT zjP{#!l(B3f*F9X=$CP|nt^)mV&lU*n)O(}4*&wJOCTI*L%Gg-5ojUHA4Yvg;Lp*(3 zftmH$5YpgqABR!_)O|0I(qHON;59FLj{#4NwZer-Wxa|?II5K zxc@`&r&@mhVxesc9Z3S>`-${@puwz`xf0|9NJsY}GF)yi^n;K)IZ+ zSAQNtmxKi;_Whr?(eLTBxV8q0g#q4T5qLjU>>Aw!@T@Tb!9pPZgI590RwQQCsd`hv zguu5!LPd!FlU<){kDtCMyu7^NkOo=pz7vn&Z5V0@o+&V?g7-#QRn>S(r^KiWh}?y# z&+f?93}IIi_Tkf?nd*_pUk;66kw+{T2@GgQzG>h+K@K(q-9sVoI@K<)?QVRLa)0{2 zkAUwL^v$r#jvyEY>>qjJArRIhB1b$L{_vRuTM#9`_PH$2N?#wcLx-zdcn=K|0`VW> zi}1xq;?syd5#+B!JV!2u|G#&Kpn&+W|2H3!Q6zrZv492^2cUuzIZW{+6qCZxYcfW% zUczY*UZ6UD@Tq;IShy1G;uYX^fW$*gOiT~HI|xzF)te33*=ArMND8}AQw-cJ=r-cy zXkTL9m{kR14&-lvj#H2f>!<4TugH5y5kx)%1jX;i0}I+(S`QvPfQ)JQdna{__o)pH z&-ox`;BVet8~-k&+=7BnA3qvtj*k>02$ndI_lfw`(smQ(6#k}n<=43Qc%I9L)uQHJ}>m~35xLvcBGh=xUD+5S1dT)c)8)N zz6a?HUyRSd@DT@iAGic9EiCdGLBtAKSC8rFIvy{+JJ~wK-8dwDpVYM)JF+q5H-asY z5l`bPLI5(-i-q_2FsDS`V;Gy5>`aw*ecd?crS3=spxfGWIivV$1S=H_O_bjjPI zAXrv=_3BN|W9hF`R#C>9QN}$u;eoh%9jo_;-`)Ep( zI@SA~Umio!3pn;kpL_C9{+=>T?(6D`<#T4F{C#;c53&$t?Mo=BAP;CVT=Y9Bb_*;M z3b0BtL~suzC^UY7>&|j&L=IX+;-*REI&z#m`F|YpKMl#fPZwcg@)tJ&8$QC>SF#Oa z&BV$4tls!%;l`SwX;B@a@M~lu(($-oK@x z4BGfM8=|!>a)8ZUcCCv`az4`jG97 zuT}vV*X#dOOv719Oe-LO`!iknL#seRPA=h@t)8;-x8-r5+mW#nwsUo{Y4o9K;4~tW zT`?cY1O@yfZf?joz4xgdK7~yDVq)r@pZDqfOgUX)UCL>Buyg_?1n+|}zJp{gh1RAJlIB6Di`(^5- zB_$3}a^RWS-W9?^=&(||?%nizE&3a7v98!rCR;3F3Y|ucI+gf+T~M2HaYp zt6Ty-&Ge?#ud)#1DX3l15fP(cb%FFur7NHY`V)8$K!C{)N9=+Rk@jU0Qz#YX?*c%) zAw>gpZLc&mPT~Hqk!coSKqad@23h&#BEC-*`1Xh;6p2^BepspkDJ&fFBS6zyn3*lO zUBRym7d)PX6BMDIgJsX9B`5np>IFnOpkrYCvOGX4dFC5^z|?1Z{Rr_U{>B1&f0CdqmS(v{ zWM6#=6D9@*i(Xw-fl-qmI&j`m6Oi)N)!l6|jeLKg#)YmX6e%x)6e07mIQmfd9yrfJ zPg`0~4-WRr&FvPk3{5K=7__!cOh{mo{#rl4<$kzcQN&Mv1?emDahw~0LT_GFf&>mu z6`5-=0$>=-LYC7yl{RDp2ccckm0(hVGo0}G*osb<;Gu#P- z`f5MAQ9}>JC9K@s<9hO7A_GF+IYS;{2B^{k32~4mRYY|3>uLvMkm6X=Kzv*dbjJDl zWmYCeMrD6OgM-a1EFgOeYz=vEh)LDxAPg*s6oFAHaY;o-7ewH&+It_fVCn<&lP4cC zeJ=TP^Yf8oSwTTTM@L6RWfU~BzoKqBpJQ&9X=1YIR1J=f8f`3_3|*B+vUq1hzzAfW zok9{!GMj!g^j*_;T(`3e3vIxl1Jd9HB`LVdrR8OaMXHZ@BYjOQp&3~j$%boKE*oX+ z@j@CYQG{T%u^+SXHZ@%$md8{RW}JVX(Y;La1SB7{4ZBmNbV5Qt@azDSn=5Yoi~9DL z)r+Wsxni%Sy=Q6@LZe7SEtFntBHDka%i&-?)TpqE?X!ST8UIsY_o{gkG(U;Copvm^|7$5EJp2UWO5n)k=|T`(O$p5W z4cY|z>IIanU$7v6V(kC~W-TU(Fvo60?;;8V(eURCz$D^c?+uj{r~>F4`UVEBe}8)k z21#TnZ)h6Sz{B>3ww`-Um>^z9N}pk>fY{Zo{yo|!A5=wK_y;b zz$LS#bUIH(dUwA(exX4* zAp3b4_9b9fQU9SgTTCY)Kl0l1ZyP+Jv~+Nt&Vv5(*R!qDy@waRx__bn$=9yjfe>bC z1%)d}e}N{J16m$f8<6Fry4nqXBJDSGa4F#2W$`>)iRLHYITce?QGv~jIsuw!utF9; zI7q+;0jq|nm>9_W_9`1M3k=JDG@LWCuoQwt_0N1pO^rJ=&VOX#Xs$#DRMeD?G*TCv z8@@Kkuuur5v#mc;(+)9~dwKJe~IFzoTt)pY|0hb6ka15>v zRQ5HTjEMR7+J}gS_xdrAZKPhH#vk(`vk#1~$XNhOFo^IA_3GV0Acjm^68qc|cx!8k z*c<2(f2{%*W@c+41r!JdR^LN3^fr= 0") + comp_clean <- gsub("\\s*(<=|>=)\\s*0\\s*$", "", as.character(bw$comparison)) + dose_contrast <- suppressWarnings(as.numeric(gsub(",", ".", sub(" - 0$", "", comp_clean)))) + if (all(is.na(dose_contrast)) && test == "Williams_JG") { + # Fallback: assign ascending treatment doses excluding control + trt_levels <- levels(df$Dose_factor)[-1] + dose_contrast <- suppressWarnings(as.numeric(trt_levels)) + dose_contrast <- dose_contrast[seq_len(min(length(dose_contrast), nrow(bw)))] + # If lengths mismatch, pad with NA + if (length(dose_contrast) < nrow(bw)) { + dose_contrast <- c(dose_contrast, rep(NA_real_, nrow(bw) - length(dose_contrast))) + } + } + names(bw)[names(bw) == "`t'-crit"] <- "Tcrit" + # Merge per-dose counts + trt_n <- merge(data.frame(Dose_factor = factor(dose_contrast, levels = levels(df$Dose_factor))), + group_n, by = "Dose_factor", all.x = TRUE) + n_t <- trt_n$n_t + # SE_diff via pooled MSE + if (is.na(mse)) stop("Cannot compute pooled MSE from ANOVA; MDD cannot be computed.") + SE_diff <- sqrt(mse * (1 / n_c + 1 / n_t)) # $$SE_{diff} = \sqrt{MSE \cdot (1/n_c + 1/n_t)}$$ + MDD <- bw$Tcrit * SE_diff # $$MDD = T_{crit} \cdot SE_{diff}$$ + MDD_pct <- if (!is.na(mu_c) && mu_c != 0) 100 * MDD / mu_c else NA_real_ # $$MDD\% = 100 \cdot MDD / \mu_c$$ + res_list <- list( + dose = dose_contrast, + n_c = rep(n_c, length(n_t)), + n_t = n_t, + df = rep(df_resid, length(n_t)), + SE_diff = SE_diff, + Tcrit = bw$Tcrit, + MDD = MDD, + MDD_pct = MDD_pct, + method = test + ) + } else if (test == "Dunnett") { + # Need multcomp + if (!requireNamespace("multcomp", quietly = TRUE)) stop("Package 'multcomp' is required for Dunnett MDD.") + # Build Dunnett contrasts and glht + contrasts_call <- as.call(list(as.name("mcp"))) + contrasts_call[[2]] <- "Dunnett" + names(contrasts_call)[2] <- factor_name + dunnett_contrasts <- eval(contrasts_call) + # Construct aov from formula x + aov_model <- stats::aov(x, data = df) + gl <- multcomp::glht(aov_model, linfct = dunnett_contrasts) + sm <- summary(gl) + # Dose from rownames of coefficients like "0.0448 - 0" + comp <- names(sm$test$coefficients) + dose_contrast <- suppressWarnings(as.numeric(gsub(",", ".", sub(" - 0$", "", comp)))) + # Standard errors per contrast come from sigma in summary (vector) + SE_diff <- as.numeric(sm$test$sigma) + # Critical value from qfunction + qfun <- sm$test$qfunction + Tcrit <- tryCatch(as.numeric(qfun(conf.level = 1 - alpha, adjusted = TRUE)), error = function(e) NA_real_) + if (is.na(Tcrit)) { + warning("Could not obtain Dunnett adjusted critical value; using unadjusted qt with residual df.") + Tcrit <- qtail(df_resid, alternative, alpha) + } + MDD <- Tcrit * SE_diff + MDD_pct <- if (!is.na(mu_c) && mu_c != 0) 100 * MDD / mu_c else NA_real_ + # n_t per contrast + trt_n <- merge(data.frame(Dose_factor = factor(dose_contrast, levels = levels(df$Dose_factor))), + group_n, by = "Dose_factor", all.x = TRUE) + n_t <- trt_n$n_t + res_list <- list( + dose = dose_contrast, + n_c = rep(n_c, length(n_t)), + n_t = n_t, + df = rep(df_resid, length(SE_diff)), + SE_diff = SE_diff, + Tcrit = rep(Tcrit, length(SE_diff)), + MDD = MDD, + MDD_pct = MDD_pct, + method = "Dunnett_multcomp" + ) + } else if (test == "t") { + # Pooled-variance per contrast (control vs each treatment) + # Compute control SD + sd_c <- stats::sd(resp[ctrl_idx]) + trt_levels <- levels(df$Dose_factor)[-1] + out_rows <- lapply(trt_levels, function(lv) { + trt_idx <- df$Dose_factor == lv + n_t <- sum(trt_idx) + sd_t <- stats::sd(resp[trt_idx]) + # pooled variance + sp2 <- ((n_c - 1) * sd_c^2 + (n_t - 1) * sd_t^2) / (n_c + n_t - 2) # $$s_p^2 = ((n_c-1)s_c^2 + (n_t-1)s_t^2) / (n_c+n_t-2)$$ + SE_diff <- sqrt(sp2 * (1 / n_c + 1 / n_t)) # $$SE_{diff} = \sqrt{s_p^2 (1/n_c + 1/n_t)}$$ + df_ct <- n_c + n_t - 2 + Tcrit <- qtail(df_ct, alternative, alpha) + MDD <- Tcrit * SE_diff + MDD_pct <- if (!is.na(mu_c) && mu_c != 0) 100 * MDD / mu_c else NA_real_ + data.frame(dose = suppressWarnings(as.numeric(lv)), n_c = n_c, n_t = n_t, + df = df_ct, SE_diff = SE_diff, Tcrit = Tcrit, MDD = MDD, MDD_pct = MDD_pct, + method = "Student_t") + }) + res_df <- do.call(rbind, out_rows) + return(res_df) + } else if (test == "Welch") { + # Welch SE and df per contrast + sd_c <- stats::sd(resp[ctrl_idx]) + trt_levels <- levels(df$Dose_factor)[-1] + out_rows <- lapply(trt_levels, function(lv) { + trt_idx <- df$Dose_factor == lv + n_t <- sum(trt_idx) + sd_t <- stats::sd(resp[trt_idx]) + SE_diff <- sqrt(sd_c^2 / n_c + sd_t^2 / n_t) # $$SE_{diff} = \sqrt{s_c^2/n_c + s_t^2/n_t}$$ + df_w <- (sd_c^2 / n_c + sd_t^2 / n_t)^2 / + ((sd_c^2 / n_c)^2 / (n_c - 1) + (sd_t^2 / n_t)^2 / (n_t - 1)) # $$df_{Welch} = \frac{(s_c^2/n_c + s_t^2/n_t)^2}{(s_c^2/n_c)^2/(n_c-1) + (s_t^2/n_t)^2/(n_t-1)}$$ + Tcrit <- qtail(df_w, alternative, alpha) + MDD <- Tcrit * SE_diff + MDD_pct <- if (!is.na(mu_c) && mu_c != 0) 100 * MDD / mu_c else NA_real_ + data.frame(dose = suppressWarnings(as.numeric(lv)), n_c = n_c, n_t = n_t, + df = df_w, SE_diff = SE_diff, Tcrit = Tcrit, MDD = MDD, MDD_pct = MDD_pct, + method = "Welch_t") + }) + res_df <- do.call(rbind, out_rows) + return(res_df) + } + + # Assemble and return tibble for Williams/Dunnett branches + res_df <- data.frame( + Dose = res_list$dose, + n_c = res_list$n_c, + n_t = res_list$n_t, + df = res_list$df, + SE_diff = res_list$SE_diff, + Tcrit = res_list$Tcrit, + MDD = res_list$MDD, + MDD_pct = res_list$MDD_pct, + method = res_list$method, + alpha = alpha, + alternative = alternative, + control_mean = mu_c + ) + # Order by Dose ascending + res_df <- res_df[order(res_df$Dose), ] + res_df +} + +``` + +Usage examples + +- Williams PMCMRplus (your MOCK0065 Growth Rate): + +```{r eval=FALSE} +w_ep <- test_cases_data %>% dplyr::filter(`Study ID` == "MOCK0065", Endpoint == "Growth Rate") +w_ep$Dose_numeric <- convert_dose(w_ep$Dose) +w_ep$Dose_factor <- factor(w_ep$Dose_numeric, levels = sort(unique(w_ep$Dose_numeric))) + +mdd_w_pm <- compute_mdd_generic(Response ~ Dose_factor, data = w_ep, + test = "Williams_PMCMRplus", alpha = 0.05, alternative = "smaller") +print(mdd_w_pm) +``` + + +- Dunnett: +```{r eval=FALSE} +mdd_dunn <- compute_mdd_generic(Response ~ Dose_factor, data = w_ep, + test = "Dunnett", alpha = 0.05, alternative = "smaller") +print(mdd_dunn) +``` +```{r eval=FALSE} +- Student’s t (pooled, control vs each dose): + +mdd_t <- compute_mdd_generic(Response ~ Dose_factor, data = w_ep, + test = "t", alpha = 0.05, alternative = "smaller") +print(mdd_t) +``` +- Welch: +```{r eval=FALSE} +mdd_welch <- compute_mdd_generic(Response ~ Dose_factor, data = w_ep, + test = "Welch", alpha = 0.05, alternative = "two-sided") +print(mdd_welch) +``` +Notes and options +- Alternative handling: MDD uses a critical value magnitude; the choice of one-sided vs two-sided changes the quantile. If your expected MDD% was computed with two-sided thresholds, set alternative = "two-sided". +- For Dunnett, the adjusted Tcrit is taken from `summary(glht)$test$qfunction`. If unavailable, we fallback to unadjusted qt with residual df. +- For `Williams_JG`, comparison strings might not carry doses; we assign doses in ascending order excluding control. If you need exact mapping, we can inspect the internal `williamsTest_JG` output via drcHelper to align rows to doses. +- You can extend the test argument to include other tests (e.g., “Dunn”) once you define the appropriate Tcrit. Dunn typically uses z critical values; for MDD you would use zcrit × SE_diff on a rank-based scale, which is a different construct; unless your expected MDD% is defined explicitly for Dunn, I recommend sticking to parametric tests above. +- If you’d like me to integrate this into your validation report, I can add an MDD% metric branch that uses compute_mdd_generic under the hood and compares to expected “MDD%” rows for Williams. + + + +# Implementation in the Validation for Williams + +Here's a self-contained helper to compute per-dose MDD% for Williams and return a tidy table. It uses your existing helpers and broom_williams output. + + +How to integrate into your validation + +- In the Williams run_actual handler, compute the prelim summary as before (for Mean, SD, %Inhibition, CV), and also compute MDD%: + +prelim <- compute_prelim_summary(endpoint_data) +mdd_tbl <- compute_mdd_williams(endpoint_data, alternative = alternative) + +# Return both; the generic runner can join MDD% when expected rows exist +list(actual_df = actual_df, group_means = prelim, mdd = mdd_tbl) + +- In your expected parsing (parse_expected_metrics for Williams), you already capture "MDD%": + +`out$mdd <- pick("\\bMDD%\\b"); names(out$mdd)[2] <- "Expected_MDDpct"`` + +- In the generic runner's join stage for Williams, add: + +```{r eval=FALSE} +if (!is.null(exp_splits$mdd) && nrow(exp_splits$mdd)) { + mdd_join <- exp_splits$mdd %>% + dplyr::left_join(actual$mdd[, c("Dose", "Actual_MDDpct")], by = "Dose") %>% + dplyr::mutate( + Endpoint = endpoint, + Diff = abs(Actual_MDDpct - Expected_MDDpct), + Status = dplyr::case_when( + is.na(Expected_MDDpct) | is.na(Actual_MDDpct) ~ "MISSING", + Diff <= tolerance ~ "PASS", TRUE ~ "FAIL") + ) %>% + dplyr::transmute(Endpoint, Dose, metric = "MDD%", Actual = Actual_MDDpct, Expected = Expected_MDDpct, Status) + pieces <- c(pieces, list(mdd_join)) +} +``` + + +### Handling "greater" vs "smaller" + +- The formula for MDD% doesn't change with direction; it's the minimum absolute difference required for significance. You typically compare magnitudes (positive values). If you want to encode a "directional" MDD% (signed), you can attach sign = ifelse(alternative=="greater", +1, -1) and report MDD%*sign, but most reports use a positive threshold. + +### Unequal sample sizes and heteroscedasticity + +- The SE_diff above already handles unequal n via 1/n_c + 1/n_t. +- If variances are heterogeneous and a Welch-type approach is used, you would estimate SE_diff via group-specific variances. Williams is based on a pooled-variance ANOVA, so the pooled MSE is appropriate here. + +**Optional: power-based MDD%** + +- If you later need to compute a power-based MDD% (target power 1−β), use: + - $$MDD_{power} = \left(t_{1-\alpha,\ df} + t_{1-\beta,\ df}\right) \cdot SE_{diff}$$ + - Then $$MDD\%_{power} = 100 \cdot MDD_{power} / \mu_c$$ +- df can be taken from the residual df of the ANOVA model. You can parameterize β (e.g., 0.2 for 80% power) and compute the quantiles using stats::qt. + +If you share one Williams study's expected MDD% values and your endpoint_data, I can quickly verify that the compute_mdd_williams output matches to within your tolerance and adjust if the expected MDD% uses a different SE (e.g., contrast-specific SE in Williams instead of the simple (1/n_c + 1/n_t) form). diff --git a/vignettes/articles/Verification-of-Williams-Test.Rmd b/vignettes/articles/Verification-of-Williams-Test.Rmd new file mode 100644 index 0000000..2a3a4fd --- /dev/null +++ b/vignettes/articles/Verification-of-Williams-Test.Rmd @@ -0,0 +1,79 @@ +--- +title: "Verification of Williams' Test" +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(drcHelper) +``` + + + +Short answer: Yes for the PMCMRplus method. broom_williams doesn’t have a formal alternative argument, but it forwards any extra arguments via ... to PMCMRplus::williamsTest, so you can pass alternative = "less" or alternative = "greater". For the Williams_JG method, you should use direction = "decreasing" or direction = "increasing" instead of alternative. + +How to verify with your dat_medium + +- Ensure the control is the first level of the dose factor (lowest dose first). +- Call broom_williams with method = "Williams_PMCMRplus" and pass alternative via ... +- Observe the "comparison" column: for alternative = "greater" you’ll see "<= 0"; for alternative = "less" you’ll see ">= 0". + + + +# Prepare the data: control first level +```{r} +dm <- dat_medium +dm$Dose_factor <- factor(dm$Dose, levels = sort(unique(dm$Dose))) +``` + + +#### PMCMRplus with alternative = "less" (one-sided, smaller/decreasing) +```{r} +bw_less <- drcHelper::broom_williams(Response ~ Dose_factor, + data = dm, + method = "Williams_PMCMRplus", + alternative = "less") +print(bw_less) + +``` + +#### PMCMRplus with alternative = "greater" (one-sided, increasing) +```{r} +bw_greater <- drcHelper::broom_williams(Response ~ Dose_factor, + data = dm, + method = "Williams_PMCMRplus", + alternative = "greater") +print(bw_greater) +``` + + +#### Williams_JG uses 'direction' instead of 'alternative' +```{r} +bw_dec <- drcHelper::broom_williams(Response ~ Dose_factor, + data = dm, + method = "Williams_JG", + direction = "decreasing") +print(bw_dec) + +bw_inc <- drcHelper::broom_williams(Response ~ Dose_factor, + data = dm, + method = "Williams_JG", + direction = "increasing") +print(bw_inc) +``` + + +## What to look for + +- In the `PMCMRplus` outputs, the comparison strings will end with "<= 0" when alternative = "greater" and ">= 0" when alternative = "less". That reflects the one-sided hypothesis direction used inside `PMCMRplus::williamsTest`. +- The JG outputs will reflect ">= 0" for direction = "decreasing" and "<= 0" for direction = "increasing". + +## Notes + +- If you try alternative = "two.sided" with PMCMRplus, it may work (depending on PMCMRplus::williamsTest implementation) but Williams is commonly used as a one-sided trend test. If you need two-sided, please run it and share the output so I can advise on how to interpret the result in your validation framework. +- Always ensure the control group is the first factor level; Williams comparisons and Tcrit depend on the factor ordering. From f54d2000001e8273e33ae0cd462f83d15477d697 Mon Sep 17 00:00:00 2001 From: Zhenglei <7943721+Zhenglei-BCS@users.noreply.github.com> Date: Wed, 24 Sep 2025 16:22:33 +0000 Subject: [PATCH 3/9] fix: Update image paths in Quantal-Data.Rmd for correct asset referencing --- vignettes/articles/Quantal-Data.Rmd | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/vignettes/articles/Quantal-Data.Rmd b/vignettes/articles/Quantal-Data.Rmd index e0b2e27..b38871a 100644 --- a/vignettes/articles/Quantal-Data.Rmd +++ b/vignettes/articles/Quantal-Data.Rmd @@ -1,8 +1,5 @@ --- title: "Quantal Data" -resource_files: - - article_assets/quantal_NOEC.png - - article_assets/binomial_tank_effects_visualization.png editor_options: chunk_output_type: console --- @@ -29,7 +26,7 @@ Analysis of quantal data typically involves the following steps as shown in the ```{r echo=FALSE,out.width="90%"} #| fig.alt: > #| Quantal NOEC Flowchart -knitr::include_graphics("article_assets/quantal_NOEC.png") +knitr::include_graphics("../assets/quantal_NOEC.png") ``` ## An example dataset From cc64c2d5e50b8441e90dce8b3c351d87ddb38367 Mon Sep 17 00:00:00 2001 From: Zhenglei <7943721+Zhenglei-BCS@users.noreply.github.com> Date: Wed, 24 Sep 2025 20:08:02 +0000 Subject: [PATCH 4/9] fix: Correct image paths in Quantal-Data.Rmd for accurate referencing --- vignettes/articles/Quantal-Data.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/articles/Quantal-Data.Rmd b/vignettes/articles/Quantal-Data.Rmd index b38871a..6addd27 100644 --- a/vignettes/articles/Quantal-Data.Rmd +++ b/vignettes/articles/Quantal-Data.Rmd @@ -26,7 +26,7 @@ Analysis of quantal data typically involves the following steps as shown in the ```{r echo=FALSE,out.width="90%"} #| fig.alt: > #| Quantal NOEC Flowchart -knitr::include_graphics("../assets/quantal_NOEC.png") +knitr::include_graphics("vignettes/assets/quantal_NOEC.png") ``` ## An example dataset @@ -438,7 +438,7 @@ ggsave("binomial_tank_effects_visualization.png", combined_plot, width = 12, hei ``` ```{r echo=FALSE,eval=FALSE,include=FALSE} -knitr::include_graphics("./../assets/binomial_tank_effects_visualization.png") +knitr::include_graphics("vignettes/assets/binomial_tank_effects_visualization.png") ``` The plot on the upper left shows the survival proportions for each tank (colored points) at each dose level. The black diamonds represent the mean survival proportion at each dose level, and the dashed line shows the theoretical dose-response relationship without tank effects. The variation among tanks at the same dose level illustrates the tank effect. From 026038d071a0c598e13e8f74c5775aab12f8312b Mon Sep 17 00:00:00 2001 From: Zhenglei <7943721+Zhenglei-BCS@users.noreply.github.com> Date: Wed, 24 Sep 2025 20:46:10 +0000 Subject: [PATCH 5/9] fix: Update image paths in Quantal-Data.Rmd to use here::here for accurate referencing --- vignettes/articles/Quantal-Data.Rmd | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/vignettes/articles/Quantal-Data.Rmd b/vignettes/articles/Quantal-Data.Rmd index 6addd27..53b50c9 100644 --- a/vignettes/articles/Quantal-Data.Rmd +++ b/vignettes/articles/Quantal-Data.Rmd @@ -13,6 +13,7 @@ knitr::opts_chunk$set( ) source("../knitr-setup.R") library(tidyverse) +library(here) ``` ```{r} @@ -26,7 +27,7 @@ Analysis of quantal data typically involves the following steps as shown in the ```{r echo=FALSE,out.width="90%"} #| fig.alt: > #| Quantal NOEC Flowchart -knitr::include_graphics("vignettes/assets/quantal_NOEC.png") +knitr::include_graphics(here::here("vignettes", "assets", "quantal_NOEC.png")) ``` ## An example dataset @@ -438,7 +439,7 @@ ggsave("binomial_tank_effects_visualization.png", combined_plot, width = 12, hei ``` ```{r echo=FALSE,eval=FALSE,include=FALSE} -knitr::include_graphics("vignettes/assets/binomial_tank_effects_visualization.png") +knitr::include_graphics(here::here("vignettes", "assets", "binomial_tank_effects_visualization.png")) ``` The plot on the upper left shows the survival proportions for each tank (colored points) at each dose level. The black diamonds represent the mean survival proportion at each dose level, and the dashed line shows the theoretical dose-response relationship without tank effects. The variation among tanks at the same dose level illustrates the tank effect. From 4d68d1466c0828358a31164e043edc479f9e15fb Mon Sep 17 00:00:00 2001 From: Zhenglei <7943721+Zhenglei-BCS@users.noreply.github.com> Date: Thu, 25 Sep 2025 14:45:06 +0000 Subject: [PATCH 6/9] Refactor code structure for improved readability and maintainability --- {vignettes => pkgdown}/assets/ECx_monotonic.png | Bin {vignettes => pkgdown}/assets/NOEC_Monotonic.png | Bin {vignettes => pkgdown}/assets/NOEC_nonMonotonic.png | Bin .../assets/binomial_tank_effects_visualization.png | Bin {vignettes => pkgdown}/assets/quantal_NOEC.png | Bin vignettes/articles/Quantal-Data.Rmd | 2 +- 6 files changed, 1 insertion(+), 1 deletion(-) rename {vignettes => pkgdown}/assets/ECx_monotonic.png (100%) rename {vignettes => pkgdown}/assets/NOEC_Monotonic.png (100%) rename {vignettes => pkgdown}/assets/NOEC_nonMonotonic.png (100%) rename {vignettes => pkgdown}/assets/binomial_tank_effects_visualization.png (100%) rename {vignettes => pkgdown}/assets/quantal_NOEC.png (100%) diff --git a/vignettes/assets/ECx_monotonic.png b/pkgdown/assets/ECx_monotonic.png similarity index 100% rename from vignettes/assets/ECx_monotonic.png rename to pkgdown/assets/ECx_monotonic.png diff --git a/vignettes/assets/NOEC_Monotonic.png b/pkgdown/assets/NOEC_Monotonic.png similarity index 100% rename from vignettes/assets/NOEC_Monotonic.png rename to pkgdown/assets/NOEC_Monotonic.png diff --git a/vignettes/assets/NOEC_nonMonotonic.png b/pkgdown/assets/NOEC_nonMonotonic.png similarity index 100% rename from vignettes/assets/NOEC_nonMonotonic.png rename to pkgdown/assets/NOEC_nonMonotonic.png diff --git a/vignettes/assets/binomial_tank_effects_visualization.png b/pkgdown/assets/binomial_tank_effects_visualization.png similarity index 100% rename from vignettes/assets/binomial_tank_effects_visualization.png rename to pkgdown/assets/binomial_tank_effects_visualization.png diff --git a/vignettes/assets/quantal_NOEC.png b/pkgdown/assets/quantal_NOEC.png similarity index 100% rename from vignettes/assets/quantal_NOEC.png rename to pkgdown/assets/quantal_NOEC.png diff --git a/vignettes/articles/Quantal-Data.Rmd b/vignettes/articles/Quantal-Data.Rmd index 53b50c9..1e42e7d 100644 --- a/vignettes/articles/Quantal-Data.Rmd +++ b/vignettes/articles/Quantal-Data.Rmd @@ -27,7 +27,7 @@ Analysis of quantal data typically involves the following steps as shown in the ```{r echo=FALSE,out.width="90%"} #| fig.alt: > #| Quantal NOEC Flowchart -knitr::include_graphics(here::here("vignettes", "assets", "quantal_NOEC.png")) +knitr::include_graphics("../../pkgdown/assets/quantal_NOEC.png") ``` ## An example dataset From 7f348bfb659cce61084d65817e537504d3b1d124 Mon Sep 17 00:00:00 2001 From: Zhenglei Gao Date: Tue, 30 Sep 2025 18:30:11 +0200 Subject: [PATCH 7/9] updated tsk_auto, SpearmanKarber_modified and MDD, --- NAMESPACE | 4 + R/MDD.R | 57 ++ R/SK_TSK_tests_wrapper.R | 553 ++++++++++++++++++ R/brsr_tsk.R | 74 ++- dev/new_function_dev/SK_TSK.qmd | 459 +++++++++++++++ man/SpearmanKarber_modified.Rd | 82 +++ man/analyze_SK.Rd | 51 ++ man/dunn_test.Rd | 79 +++ man/print.dunn_test_result.Rd | 16 + .../articles/MDD-in-Regulatory-Context.Rmd | 65 +- vignettes/articles/TSK_method.Rmd | 317 +++++++++- .../Verification-of-Williams-Test.Rmd | 2 +- 12 files changed, 1716 insertions(+), 43 deletions(-) create mode 100644 R/MDD.R create mode 100644 R/SK_TSK_tests_wrapper.R create mode 100644 dev/new_function_dev/SK_TSK.qmd create mode 100644 man/SpearmanKarber_modified.Rd create mode 100644 man/analyze_SK.Rd create mode 100644 man/dunn_test.Rd create mode 100644 man/print.dunn_test_result.Rd diff --git a/NAMESPACE b/NAMESPACE index e0db266..308b16c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ S3method(plot,dunnett_test_result) S3method(print,RSCABS) S3method(print,StepDownRSCABS) S3method(print,drcComp) +S3method(print,dunn_test_result) S3method(print,dunnett_test_result) S3method(print,stepDownTrendBinom) S3method(print,tskresult) @@ -19,11 +20,13 @@ export(ECx_rating) export(ED.ZG) export(ED.plus) export(RSCABK) +export(SpearmanKarber_modified) export(Tarone.test) export(Tarone.trend.test) export(addECxCI) export(aggregate_from_individual_simple) export(aggregate_from_individual_tidy) +export(analyze_SK) export(backCalcSE) export(broom_dunnett) export(broom_williams) @@ -39,6 +42,7 @@ export(convert_fish_data) export(create_contingency_table) export(dose.p.glmmPQL) export(drcCompare) +export(dunn_test) export(dunnett_test) export(expand_to_individual_simple) export(expand_to_individual_tidy) diff --git a/R/MDD.R b/R/MDD.R new file mode 100644 index 0000000..150467f --- /dev/null +++ b/R/MDD.R @@ -0,0 +1,57 @@ +#' Calculate MDD% for a Williams Test Result +#' +#' @param williams_obj The tibble result from broom_williams. +#' @param data The original dataframe used for the test. +#' @param formula The formula used for the test, e.g., Response ~ Dose. +#' @return A tibble with Dose, MDD, and MDD_pct. +#' @export +compute_mdd_williams <- function(williams_obj, data, formula) { + + if (!inherits(williams_obj, "tbl_df") || !all(c("comparison", "t'-crit") %in% names(williams_obj))) { + stop("williams_obj must be the result from a broom_williams call.") + } + if (nrow(williams_obj) == 0) return(tibble::tibble(Dose=numeric(), MDD_pct=numeric())) + + # 1. Extract variable names + resp_name <- all.vars(formula)[1] + dose_name <- all.vars(formula)[2] # Correctly gets "Dose" + + # --- START OF FIX --- + # Create a local copy of the data to avoid modifying the original + local_data <- data + + # Ensure the dose column is a factor with control (0) as the first level. + # This makes the function robust and independent of the input data's column type. + dose_values <- local_data[[dose_name]] + factor_levels <- sort(unique(dose_values)) + local_data$dose_factor_col <- factor(dose_values, levels = factor_levels) + + # Define the new, reliable factor column name and update formula for aov() + factor_col_name <- "dose_factor_col" + aov_formula <- as.formula(paste(resp_name, "~", factor_col_name)) + # --- END OF FIX --- + + # 2. Extract info from the Williams test object + Tcrit <- williams_obj[["t'-crit"]] + doses <- as.numeric(gsub(" - 0.*", "", williams_obj$comparison)) + + # 3. Get ANOVA stats (MSE) using the corrected formula and local data + aov_fit <- stats::aov(aov_formula, data = local_data) + mse <- summary(aov_fit)[[1]]["Residuals", "Mean Sq"] + + # 4. Get control group stats using the reliable factor column + control_level <- levels(local_data[[factor_col_name]])[1] + ctrl_data <- local_data[local_data[[factor_col_name]] == control_level, ] + mu_c <- mean(ctrl_data[[resp_name]], na.rm = TRUE) + n_c <- nrow(ctrl_data) + + # 5. Get treatment sample sizes + n_t <- sapply(doses, function(d) sum(local_data[[dose_name]] == d)) + + # 6. Calculate MDD and MDD% + SE_diff <- sqrt(mse * (1 / n_c + 1 / n_t)) + MDD <- Tcrit * SE_diff + MDD_pct <- 100 * MDD / abs(mu_c) + + tibble::tibble(Dose = doses, MDD_pct = MDD_pct) +} diff --git a/R/SK_TSK_tests_wrapper.R b/R/SK_TSK_tests_wrapper.R new file mode 100644 index 0000000..8fe1f0b --- /dev/null +++ b/R/SK_TSK_tests_wrapper.R @@ -0,0 +1,553 @@ +## README +## Functions included in this R file +##* *SpearmanKarber_modified* +##* *Modular `extract_*` Functions: +##* + + +## A cleaned-up and fixed version of Harold's SpearmanKarber_modified function. +## It corrects indexing, handles zero-dose safely, avoids hard-coded sizes, +## simplifies pruning/pooling when control mortality > 0, and computes CIs in a stable way. +## I kept your two-branch logic (p0 ≈ 0 vs p0 > 0) and Fieller CI for the latter. + +#' Spearman-Karber Estimation with Modified Handling for Control Mortality +#' +#' Estimates the LC50 (median lethal concentration) or ED50 (median effective dose) +#' and its confidence interval using the Spearman-Karber method. This version includes +#' robust handling for zero-dose (control) mortality and a Fieller-like approach for +#' confidence interval estimation when control mortality is non-zero. +#' +#' @details +#' The function operates in two branches: +#' - If control mortality (p0) is near zero, the standard Spearman-Karber method is used on the log-transformed doses, assuming the first observed response is 0%. +#' - If p0 is non-zero, it estimates the background rate (c) by cumulative pooling, Abbott-corrects the proportions, prunes/pools low-dose groups, and uses a modified Spearman-Karber method on the scaled proportions. Confidence intervals are calculated using an approach inspired by Fieller's theorem to account for the background correction uncertainty. +#' +#' All concentrations must be non-negative and in increasing order. +#' +#' @param conc A numeric vector of doses or concentrations (must be >= 0 and in increasing order). +#' @param dead A numeric vector of the number of organisms that died or responded at each \code{conc} level. +#' @param total A numeric vector of the total number of organisms (population size) at each \code{conc} level. Can be a single value if all are the same. +#' @param conf.level A single numeric value specifying the confidence level for the interval estimation (e.g., 0.95 for a 95% CI). Must be in (0, 1). +#' @param retData A logical value. If \code{TRUE}, the results are returned in a list. If \code{FALSE}, \code{invisible(NULL)} is returned. +#' @param showOutput A logical value. If \code{TRUE}, the input data table and estimation results (including log-scale values and CIs) are printed to the console. +#' @param showPlot A logical value. If \code{TRUE}, a plot is generated showing the observed and Abbott-corrected mortalities/responses, the estimated LC50, and its confidence interval. +#' +#' @return A list containing the estimation results if \code{retData} is \code{TRUE}, otherwise \code{invisible(NULL)}. The list includes: +#' \item{\code{log10LC50}}{Estimated log10 of the LC50.} +#' \item{\code{varianceOfLog10LC50}}{Estimated variance of log10LC50.} +#' \item{\code{StandardDeviationOfm}}{Estimated standard deviation of log10LC50.} +#' \item{\code{confidenceIntervalLog10}}{CI for log10LC50 (vector of two values).} +#' \item{\code{LC50}}{Estimated LC50 (10^log10LC50).} +#' \item{\code{confidenceIntervalLC50}}{CI for LC50 (vector of two values).} +#' \item{\code{conf.level}}{The confidence level used for the CIs.} +#' +#' @export +#' +#' @references +#' ART CARTER, WYETH-AYERST RESEARCH, CHAZY, NY (1994): Using the Spearman-Karber Method to Estimate the ED50. +#' Proceedings of the Nineteenth Annual SAS Users Group International Conference, Dallas, Texas, April, pp. 10-13. +#' \url{http://www.sascommunity.org/sugi/SUGI94/Sugi-94-195%20Carter.pdf}. +#' +#' @seealso \code{\link[drcHelper]{tsk_auto}} +#' +#' @author Sarah Baumert, Harald Schulz, Zhenglei Gao +#' +#' @examples +#' # Example 1: Zero control mortality (standard Spearman-Karber) +#' x1 <- c(0, 0.2, 0.3, 0.375, 0.625, 2) +#' n1 <- c(30, 30, 30, 30, 30, 30) +#' r1 <- c(0, 1, 3, 16, 24, 30) +#' SpearmanKarber_modified(x1, r1, n1, showOutput = TRUE) +#' +#' # Example 2: Non-zero control mortality (modified method) +#' x2 <- c(0, 15.54, 20.47, 27.92, 35.98, 55.52) +#' n2 <- c(40, 40, 40, 40, 40, 40) +#' r2 <- c(3, 2, 6, 11, 18, 33) +#' results <- SpearmanKarber_modified(x2, r2, n2, retData = TRUE, +#' showOutput = TRUE, showPlot = TRUE) +#' print(results$LC50) +SpearmanKarber_modified <- function(conc, dead, total, + conf.level = 0.95, + retData = TRUE, showOutput = FALSE, showPlot = FALSE) { + # Basic checks + if (any(is.na(conc))) stop("conc must not contain NA") + if (any(is.na(dead))) stop("dead must not contain NA") + if (any(is.na(total))) stop("total must not contain NA") + if (!is.numeric(conc)) stop("conc must be numeric") + if (!is.numeric(dead)) stop("dead must be numeric") + if (!is.numeric(total)) stop("total must be numeric") + + N <- length(conc) + if (N != length(dead)) stop("Different numbers of concentrations and responses were given") + if (length(total) == 1) total <- rep(total, N) + if (N != length(total)) stop("Different numbers of concentrations and subject groups were given") + if (any(conc < 0)) stop("All concentrations must be >= 0. Provide concentrations, not log10(concentrations).") + if (!all(conc == conc[order(conc)])) stop("Data must be in order of increasing concentration.") + if (any(dead < 0)) stop("Dead (responses) must be >= 0") + if (any(total <= 0)) stop("Population sizes must be > 0") + if (any(dead > total)) stop("dead cannot exceed total") + if (conf.level <= 0 || conf.level >= 1) stop("conf.level must be in (0,1)") + + # Observed proportions + p <- dead / total + p0 <- p[1] + eps <- .Machine$double.eps^0.5 + z <- stats::qnorm(1 - (1 - conf.level) / 2) + + # Abbott-corrected proportions for reporting/plotting (clamped to [0,1]) + if (p0 >= 1 - 1e-12) { + stop("Control mortality is 100% (or extremely close). Spearman-Karber not applicable.") + } + pAbbott <- (p - p0) / (1 - p0) + pAbbott <- pmin(pmax(pAbbott, 0), 1) + adjustCounts <- pAbbott * total + + # Containers for outputs + mu <- NA_real_ + LC50 <- NA_real_ + varianceOfMu <- NA_real_ + ciMu <- c(NA_real_, NA_real_) + ciLC50 <- c(NA_real_, NA_real_) + ciHalfWidth <- NA_real_ # for reporting convenience + + # Helper for variance term with interior i + # xlog is log10(x) for positive x; t is totals for same indices; pin is proportions (not Abbott) for same indices + variance_SK <- function(xlog, pin, t) { + M <- length(xlog) + if (M < 3) return(NA_real_) + v <- 0 + for (i in 2:(M - 1)) { + v <- v + 0.25 * (xlog[i - 1] - xlog[i + 1])^2 * (pin[i] * (1 - pin[i])) / t[i] + } + v + } + + # Case A: control mortality effectively zero + if (p0 <= eps) { + # Use only positive concentrations for log10 + pos_idx <- which(conc > 0) + if (length(pos_idx) < 2L) { + stop("Need at least two positive concentrations when control mortality is zero.") + } + x <- conc[pos_idx] + p_use <- p[pos_idx] # equals pAbbott[pos_idx] since p0 ~ 0 + t_use <- total[pos_idx] + + # Build extended log-dose with ghost endpoints + xlog_ext <- numeric(length(x) + 2L) + xlog_ext[2:(length(x) + 1L)] <- log10(x) + # Low ghost (needs at least two positive x) + xlog_ext[1] <- 2 * xlog_ext[2] - xlog_ext[3] + # High ghost + xlog_ext[length(x) + 2L] <- 2 * xlog_ext[length(x) + 1L] - xlog_ext[length(x)] + + # Build extended proportions: 0 at low, observed in middle, 1 at high + p_ext <- numeric(length(p_use) + 2L) + p_ext[1] <- 0 + p_ext[2:(length(p_use) + 1L)] <- p_use + p_ext[length(p_use) + 2L] <- 1 + + # Spearman-Karber trapezoid + mids <- 0.5 * (xlog_ext[-length(xlog_ext)] + xlog_ext[-1]) + dp <- diff(p_ext) + mu <- sum(dp * mids) + LC50 <- 10^mu + + # Variance on observed internal points (interior of observed grid, not ghosts) + v <- variance_SK(xlog = xlog_ext[2:(length(xlog_ext) - 1L)], + pin = p_use, + t = t_use) + varianceOfMu <- if (is.na(v)) NA_real_ else max(v, 0) + sdMu <- if (is.na(varianceOfMu)) NA_real_ else sqrt(varianceOfMu) + if (!is.na(sdMu)) { + ciMu <- c(mu - z * sdMu, mu + z * sdMu) + ciLC50 <- 10^ciMu + ciHalfWidth <- z * sdMu + } + + } else { + # Case B: nonzero control mortality, estimate background c by cumulative pooling + cum_dead <- cumsum(dead) + cum_total <- cumsum(total) + cum_ratio <- cum_dead / cum_total + k_star <- which.min(cum_ratio)[1] + c_bg <- cum_ratio[k_star] + n_c <- cum_total[k_star] + + # Prune: keep all observations with p >= c_bg - small tolerance; pool others into the first kept + keep_mask <- p >= (c_bg - 1e-12) + if (!any(keep_mask)) stop("After background-rate screening, no observations remain.") + keep_idx <- which(keep_mask) + # Ensure order + x_keep <- conc[keep_idx] + d_keep <- dead[keep_idx] + n_keep <- total[keep_idx] + + # Pool the excluded into the first kept entry + if (any(!keep_mask)) { + d_pool <- sum(dead[!keep_mask]) + n_pool <- sum(total[!keep_mask]) + d_keep[1] <- d_keep[1] + d_pool + n_keep[1] <- n_keep[1] + n_pool + } + + # Ensure positive concentrations for integration; pool any nonpositive into first positive + pos_keep <- which(x_keep > 0) + if (length(pos_keep) < 2L) { + stop("Need at least two positive concentrations after background-rate adjustment.") + } + if (any(x_keep <= 0)) { + first_pos <- pos_keep[1] + d_keep[first_pos] <- d_keep[first_pos] + sum(d_keep[x_keep <= 0]) + n_keep[first_pos] <- n_keep[first_pos] + sum(n_keep[x_keep <= 0]) + keep_positive <- x_keep > 0 + x_keep <- x_keep[keep_positive] + d_keep <- d_keep[keep_positive] + n_keep <- n_keep[keep_positive] + } + + p_keep <- d_keep / n_keep + xlog <- log10(x_keep) + M <- length(xlog) + + # Rescale by background-rate c to [0,1]; force the first to be exactly 0 + p_scaled <- (p_keep - c_bg) / (1 - c_bg) + p_scaled <- pmin(pmax(p_scaled, 0), 1) + p_scaled[1] <- 0 + + # Append a high ghost endpoint at p=1 and log-dose extrapolated + xlog_ext <- c(xlog, 2 * xlog[M] - xlog[M - 1]) + p_scaled_ext <- c(p_scaled, 1) + + # Raw SK on scaled proportions + mids <- 0.5 * (xlog_ext[-length(xlog_ext)] + xlog_ext[-1]) + dp <- diff(p_scaled_ext) + mu_raw <- sum(dp * mids) + + # Variance on original (unscaled) proportions, interior points only + v_raw <- variance_SK(xlog = xlog, pin = p_keep, t = n_keep) + varianceOfMu <- if (is.na(v_raw)) NA_real_ else max(v_raw, 0) + + # Fieller-based CI on log-scale (following your structure) + a <- 0.5 * (xlog[1] + xlog[2]) # first-segment midpoint + V12 <- (a^2) * c_bg * (1 - c_bg) / n_c + V22 <- c_bg * (1 - c_bg) / n_c + V11 <- varianceOfMu + V12 + B <- 1 - c_bg + g <- (z^2) * V22 / (B^2) + # Guard against edge cases + discr <- V11 - 2 * mu_raw * V12 + (mu_raw^2) * V22 - g * (V11 - (V12^2) / V22) + discr <- max(discr, 0) + denom <- (1 - g) + if (abs(denom) < 1e-12) { + sigma <- NA_real_ + } else { + sigma <- (z / B) * sqrt(discr) / denom + } + # Adjust mu for background c + mu <- (mu_raw - c_bg * a) / (1 - c_bg) + LC50 <- 10^mu + + if (is.finite(sigma)) { + ciMu <- sort(c(mu - sigma, mu + sigma)) + ciLC50 <- 10^ciMu + # Back out a variance proxy from sigma (approximate) + varianceOfMu <- max((sigma / z)^2, varianceOfMu) + ciHalfWidth <- sigma + } else { + ciMu <- c(NA_real_, NA_real_) + ciLC50 <- c(NA_real_, NA_real_) + ciHalfWidth <- NA_real_ + } + } + + # Plot if requested + if (isTRUE(showPlot)) { + xlimMax <- max(conc, na.rm = TRUE) + plot(conc, p * 100, type = "p", pch = 4, xlim = c(0, xlimMax), + ylim = c(0, 100), ylab = "Response, %", xlab = "Concentration", cex = 0.7) + lines(conc, pAbbott * 100, lty = 2) + legend("topleft", + c("Observed Mortality %", "Abbott-corrected %"), + lty = c(0, 2), pch = c(4, NA), cex = 0.8, bty = "n") + points(LC50, 50, pch = 16, col = "blue") + # horizontal error bar for LC50 CI (if available) + if (all(is.finite(ciLC50))) { + segments(x0 = ciLC50[1], y0 = 50, x1 = ciLC50[2], y1 = 50, col = "blue") + segments(x0 = ciLC50[1], y0 = 50 - 2, x1 = ciLC50[1], y1 = 50 + 2, col = "blue") + segments(x0 = ciLC50[2], y0 = 50 - 2, x1 = ciLC50[2], y1 = 50 + 2, col = "blue") + } + } + + # Console output if requested + if (isTRUE(showOutput)) { + out <- data.frame( + idx = seq_len(N), + concentration = conc, + total = total, + dead = dead, + obs_prop = round(p, 6), + abbott_prop = round(pAbbott, 6), + abbott_count = round(adjustCounts, 3) + ) + print(out, row.names = FALSE) + cat("log10(LC50) =", mu, "\n") + cat("estimated variance of log10(LC50) =", varianceOfMu, "\n") + cat("approx. half-width on log10-scale =", ciHalfWidth, "\n") + cat(paste0(round(100 * conf.level, 1), "% CI for log10(LC50) = [", + paste(ciMu, collapse = ", "), "]\n")) + cat("estimated LC50 =", LC50, "\n") + cat(paste0("estimated ", round(100 * conf.level, 1), "% CI for LC50 = [", + paste(ciLC50, collapse = ", "), "]\n")) + } + + if (isTRUE(retData)) { + return(list( + log10LC50 = mu, + varianceOfLog10LC50 = varianceOfMu, + StandardDeviationOfm = if (is.na(varianceOfMu)) NA_real_ else sqrt(varianceOfMu), + confidenceIntervalLog10 = ciMu, + LC50 = LC50, + confidenceIntervalLC50 = ciLC50, + conf.level = conf.level + )) + } else { + invisible(NULL) + } +} + + + + + +##* **Modular `extract_*` Functions:** +##* I created a set of individual `extract_*` functions, one for each SK method. +##* Each function runs its respective model, safely captures key results (LC50, CI, etc.), +##* and returns them in a standardized, single-row data frame. +##* This allows you to easily combine their outputs into a final comparison table. + +# REVISED: Helper to create a standardized output row with clearer SD columns +standard_row <- function(method, scale, trim_or_A = NA, est = NA, lcl = NA, ucl = NA, + log10est = NA, sd_lc50 = NA, sd_log10 = NA, gsd = NA, + notes = "") { + data.frame( + method = as.character(method), + scale = as.character(scale), + trim_or_A = as.numeric(trim_or_A), + LC50 = as.numeric(est), + LCL = as.numeric(lcl), + UCL = as.numeric(ucl), + log10LC50 = as.numeric(log10est), + SD_LC50 = as.numeric(sd_lc50), # SD on the same scale as LC50 + SD_log10 = as.numeric(sd_log10), # SD on the log10 scale + GSD = as.numeric(gsd), + notes = as.character(notes), + stringsAsFactors = FALSE + ) +} + + +# CORRECTED: For drcHelper::tsk_auto +extract_tsk_auto <- function(x, n, r, use.log.doses = TRUE, conf.level = 0.95) { + method_name <- "tsk_auto" + scale_name <- if (use.log.doses) "log-dose" else "linear-dose" + + obj <- try( + drcHelper::tsk_auto(data.frame(x = x, n = n, r = r), use.log.doses = use.log.doses, conf.level = conf.level), + silent = TRUE + ) + + if (inherits(obj, "try-error")) { + return(standard_row(method_name, scale_name, notes = as.character(obj))) + } + + `%||%` <- function(a, b) if (!is.null(a)) a else b + + # *** THE FIX IS HERE: Added obj$mu to the list of possible estimate names *** + est <- obj$LD50 %||% obj$ED50 %||% obj$mu %||% NA + + ci <- obj$conf.int %||% obj$ci %||% c(NA, NA) + sd_val <- obj$sd %||% obj$SD %||% NA + gsd_val <- obj$GSD %||% obj$gsd %||% NA + trim_val <- obj$trim %||% attr(obj, "trim") %||% NA + + standard_row( + method = method_name, + scale = scale_name, + trim_or_A = trim_val, + est = est, + lcl = ci[1], + ucl = ci[2], + log10est = if (is.finite(est) && est > 0) log10(est) else NA, + sd_lc50 = if (!use.log.doses) sd_val else NA, # SD(LC50) is returned for linear scale + sd_log10 = if (use.log.doses && is.finite(gsd_val)) log(gsd_val) else NA, # SD(log10) is ~log(GSD) for log scale + gsd = gsd_val + ) +} + + +# UPDATED: For your custom function to match new standard_row +extract_SpearmanKarber_modified <- function(x, n, r, conf.level = 0.95) { + skm <- try( + SpearmanKarber_modified(x, r, n, conf.level = conf.level, retData = TRUE), + silent = TRUE + ) + + if (inherits(skm, "try-error")) { + return(standard_row("SpearmanKarber_modified", "log-dose", notes = as.character(skm))) + } + + standard_row( + method = "SpearmanKarber_modified", + scale = "log-dose", + est = skm$LC50, + lcl = skm$confidenceIntervalLC50[1], + ucl = skm$confidenceIntervalLC50[2], + log10est = skm$log10LC50, + sd_log10 = if (!is.null(skm$StandardDeviationOfm)) skm$StandardDeviationOfm else NA + ) +} + + +# UPDATED: For ecotoxicology::SpearmanKarber to match new standard_row +extract_ecotox_SpearmanKarber <- function(x, n, r) { + if (length(unique(n)) != 1) { + return(standard_row("ecotox::SpearmanKarber", "log-dose", notes = "Requires constant N")) + } + + use_idx <- which(x > 0) + if (length(use_idx) < 2) { + return(standard_row("ecotox::SpearmanKarber", "log-dose", notes = "Requires at least 2 positive doses")) + } + + toxData <- cbind(x[use_idx], r[use_idx], r[use_idx] / n[use_idx]) + + obj <- try( + ecotoxicology::SpearmanKarber(toxData, N = unique(n)[1], retData = TRUE, showOutput = FALSE, showPlot = FALSE), + silent = TRUE + ) + + if (inherits(obj, "try-error")) { + return(standard_row("ecotox::SpearmanKarber", "log-dose", notes = as.character(obj))) + } + + standard_row( + method = "ecotox::SpearmanKarber", + scale = "log-dose", + est = obj$LC50, + lcl = obj$confidenceInterval95LC50[1], + ucl = obj$confidenceInterval95LC50[2], + log10est = obj$log10LC50, + sd_log10 = if (!is.null(obj$varianceOfm)) sqrt(obj$varianceOfm) else NA + ) +} + + + +#' Unified Spearman-Karber Analysis Function +#' +#' This function serves as a wrapper to run various Spearman-Karber (SK) and +#' Trimmed Spearman-Karber (TSK) analyses using a single interface. +#' It returns a standardized one-row data frame for easy comparison. +#' +#' @param x Numeric vector of concentrations. +#' @param n Numeric vector of total subjects per concentration. +#' @param r Numeric vector of responses (e.g., dead) per concentration. +#' @param method The analysis method to use. Must be one of: +#' - "SK_modified" (your custom SpearmanKarber_modified function) +#' - "tsk_auto_log" (drcHelper::tsk_auto with log-doses) +#' - "tsk_auto_linear" (drcHelper::tsk_auto with linear doses) +#' - "ecotox_SK" (ecotoxicology::SpearmanKarber) +#' @param conf.level The confidence level for intervals (default 0.95). +#' @param ... Additional arguments passed to the underlying functions (e.g., max.trim for tsk_auto). +#' +#' @return A single-row data frame containing the standardized analysis results. +#' @export +#' +#' @examples +#' x <- c(0, 0.2, 0.3, 0.375, 0.625, 2) +#' n <- c(30, 30, 30, 30, 30, 30) +#' r <- c(0, 1, 3, 16, 24, 30) +#' +#' # Run a single analysis +#' analyze_SK(x, n, r, method = "SK_modified") +#' +#' # Run multiple analyses and combine into a single table +#' methods_to_run <- c("SK_modified", "tsk_auto_log", "tsk_auto_linear", "ecotox_SK") +#' all_results <- lapply(methods_to_run, function(m) { +#' analyze_SK(x, n, r, method = m) +#' }) +#' comparison_table <- do.call(rbind, all_results) +#' print(comparison_table) +analyze_SK <- function(x, n, r, method, conf.level = 0.95, ...) { + # --- Input Validation --- + available_methods <- c("SK_modified", "tsk_auto_log", "tsk_auto_linear", "ecotox_SK") + if (!method %in% available_methods) { + stop(paste("Unknown method specified. Please choose from:", paste(available_methods, collapse = ", "))) + } + + dots <- list(...) + + # --- Method Dispatch using switch() --- + switch( + method, + + "SK_modified" = { + obj <- try(SpearmanKarber_modified(x, r, n, conf.level = conf.level, retData = TRUE), silent = TRUE) + if (inherits(obj, "try-error")) { + return(standard_row(method, "log-dose", notes = as.character(obj))) + } + standard_row(method, "log-dose", + est = obj$LC50, lcl = obj$confidenceIntervalLC50[1], ucl = obj$confidenceIntervalLC50[2], + log10est = obj$log10LC50, sd_log10 = obj$StandardDeviationOfm) + }, + + "tsk_auto_log" = { + call_args <- c(list(data.frame(x = x, n = n, r = r), use.log.doses = TRUE, conf.level = conf.level), dots) + obj <- try(do.call(drcHelper::tsk_auto, call_args), silent = TRUE) + if (inherits(obj, "try-error")) { + return(standard_row(method, "log-dose", notes = as.character(obj))) + } + est <- obj$LD50 %||% obj$ED50 %||% obj$mu %||% NA + ci <- obj$conf.int %||% obj$ci %||% c(NA, NA) + gsd <- obj$GSD %||% obj$gsd %||% NA + standard_row(method, "log-dose", trim_or_A = obj$trim %||% attr(obj, "trim"), + est = est, lcl = ci[1], ucl = ci[2], + log10est = if (is.finite(est) && est > 0) log10(est) else NA, + sd_log10 = if (is.finite(gsd)) log(gsd) else NA, gsd = gsd) + }, + + "tsk_auto_linear" = { + call_args <- c(list(data.frame(x = x, n = n, r = r), use.log.doses = FALSE, conf.level = conf.level), dots) + obj <- try(do.call(drcHelper::tsk_auto, call_args), silent = TRUE) + if (inherits(obj, "try-error")) { + return(standard_row(method, "linear-dose", notes = as.character(obj))) + } + est <- obj$LD50 %||% obj$ED50 %||% obj$mu %||% NA + ci <- obj$conf.int %||% obj$ci %||% c(NA, NA) + sd_val <- obj$sd %||% obj$SD %||% NA + standard_row(method, "linear-dose", trim_or_A = obj$trim %||% attr(obj, "trim"), + est = est, lcl = ci[1], ucl = ci[2], + log10est = if (is.finite(est) && est > 0) log10(est) else NA, + sd_lc50 = sd_val) + }, + + "ecotox_SK" = { + if (length(unique(n)) != 1) { + return(standard_row(method, "log-dose", notes = "Requires constant N")) + } + use_idx <- which(x > 0) + if (length(use_idx) < 2) { + return(standard_row(method, "log-dose", notes = "Requires at least 2 positive doses")) + } + toxData <- cbind(x[use_idx], r[use_idx], r[use_idx] / n[use_idx]) + obj <- try(ecotoxicology::SpearmanKarber(toxData, N = unique(n)[1], retData = TRUE, showOutput = FALSE, showPlot = FALSE), silent = TRUE) + if (inherits(obj, "try-error")) { + return(standard_row(method, "log-dose", notes = as.character(obj))) + } + standard_row(method, "log-dose", + est = obj$LC50, lcl = obj$confidenceInterval95LC50[1], ucl = obj$confidenceInterval95LC50[2], + log10est = obj$log10LC50, sd_log10 = if (!is.null(obj$varianceOfm)) sqrt(obj$varianceOfm) else NA) + } + ) +} diff --git a/R/brsr_tsk.R b/R/brsr_tsk.R index a253e0b..c1002df 100644 --- a/R/brsr_tsk.R +++ b/R/brsr_tsk.R @@ -29,6 +29,19 @@ #' tsk <- function(...) UseMethod("tsk") +## wrapper for extracting output. not used anymore, see @extract_tsk_auto +extract_tsk_like <- function(obj) { + # Try common fields; fall back to NA + est <- obj$LD50 %||% obj$ED50 %||% obj$estimate %||% NA_real_ + lcl <- (obj$conf.int %||% obj$ci %||% c(NA_real_, NA_real_))[1] + ucl <- (obj$conf.int %||% obj$ci %||% c(NA_real_, NA_real_))[2] + sd <- obj$sd %||% obj$SE %||% NA_real_ + gsd <- obj$GSD %||% obj$gsd %||% NA_real_ + list(est = as.numeric(est), lcl = as.numeric(lcl), ucl = as.numeric(ucl), + sd = as.numeric(sd), gsd = as.numeric(gsd)) +} + + #' Auto-trimmed TSK Analysis #' #' This function automatically determines the appropriate trim level for TSK analysis @@ -40,15 +53,15 @@ tsk <- function(...) UseMethod("tsk") #' from the trim level to 1-trim level, which typically occurs when responses are #' too close to 0% or 100% at the extreme doses. #' -#' @param x A numeric vector of doses (for numeric method) or a data frame +#' @param x A numeric vector of doses (for numeric method) or a data frame #' containing columns 'x', 'n', and 'r' (for data.frame method). #' @param n A numeric vector of total counts (for numeric method only). #' @param r A numeric vector of response counts (for numeric method only). #' @param control A numeric value indicating the control dose (default is 0). #' @param conf.level A numeric value indicating the confidence level (default is 0.95). -#' @param use.log.doses A logical value indicating whether to use log-transformed +#' @param use.log.doses A logical value indicating whether to use log-transformed #' doses (default is TRUE). -#' @param max.trim A numeric value indicating the maximum allowed trim level +#' @param max.trim A numeric value indicating the maximum allowed trim level #' (default is 0.45, must be < 0.5). #' @param ... Additional arguments passed to the tsk function. #' @return The result of the TSK analysis with automatic trimming applied. @@ -68,7 +81,7 @@ tsk <- function(...) UseMethod("tsk") #' r = c(2, 5, 8, 12, 15, 17) #' ) #' result <- tsk_auto(data) -#' +#' #' # Using hamilton dataset (if available) #' if (exists("hamilton")) { #' # Try with one of the hamilton datasets @@ -82,7 +95,7 @@ tsk_auto <- function(x, ...) { #' @rdname tsk_auto #' @method tsk_auto numeric #' @export -tsk_auto.numeric <- function(x, n, r, control = 0, conf.level = 0.95, +tsk_auto.numeric <- function(x, n, r, control = 0, conf.level = 0.95, use.log.doses = TRUE, max.trim = 0.45, ...) { input <- data.frame(x = x, n = n, r = r) tsk_auto.data.frame(input, control = control, conf.level = conf.level, @@ -92,15 +105,48 @@ tsk_auto.numeric <- function(x, n, r, control = 0, conf.level = 0.95, #' @rdname tsk_auto #' @method tsk_auto data.frame #' @export -tsk_auto.data.frame <- function(x, control = 0, conf.level = 0.95, +tsk_auto.data.frame <- function(x, control = 0, conf.level = 0.95, use.log.doses = TRUE, max.trim = 0.45, ...) { input <- x - + # Optional: strip 'trim' from ... to avoid duplicate matching if user passes it to tsk_auto + dots <- list(...) + if (!is.null(dots$trim)) { + warning("tsk_auto ignores 'trim'. Use drcHelper::tsk(...) for explicit trims. Removing 'trim' from ...") + dots$trim <- NULL + } + # Validate max.trim if (max.trim <= 0 || max.trim >= 0.5) { stop("max.trim must be between 0 and 0.5 (exclusive).") } - + # ADD THIS BLOCK: preemptively trim if log-doses requested and zero (or negative) doses exist + if (isTRUE(use.log.doses) && any(input$x <= 0, na.rm = TRUE)) { + # Minimal safe trim: roughly 1/min(total per dose), capped by max.trim + # Falls back to 0.001 if totals are missing + base_trim <- tryCatch(1 / max(input$n, na.rm = TRUE), error = function(e) NA_real_) + if (!is.finite(base_trim) || base_trim <= 0) base_trim <- 0.001 + auto_trim <- min(base_trim, max.trim) + + message(sprintf("tsk_auto: zero dose with log transform detected; applying auto-trim = %.4f", auto_trim)) + # Try trimmed call; if it fails with a “suggested trim” message, upgrade trim slightly (capped) + return(tryCatch( + do.call(tsk, c(list(input, control = control, trim = auto_trim, conf.level = conf.level, + use.log.doses = use.log.doses), dots)), + error = function(e) { + if (grepl("consider using this trim:", e$message)) { + suggested_trim_match <- regmatches(e$message, regexpr("consider using this trim: [0-9.]+", e$message)) + if (length(suggested_trim_match) > 0) { + suggested_trim <- as.numeric(sub("consider using this trim: ", "", suggested_trim_match)) + auto_trim2 <- min(suggested_trim + 0.001, max.trim) + message(sprintf("tsk_auto: increasing auto-trim to %.4f due to suggestion", auto_trim2)) + return(do.call(tsk, c(list(input, control = control, trim = auto_trim2, conf.level = conf.level, + use.log.doses = use.log.doses), dots))) + } + } + stop(e) + } + )) + } # First try with no trimming result <- tryCatch({ tsk(input, control = control, trim = 0, conf.level = conf.level, @@ -109,18 +155,18 @@ tsk_auto.data.frame <- function(x, control = 0, conf.level = 0.95, # Only apply auto-trimming for specific trim-related errors if (grepl("responses do not increase from trim to 1-trim", e$message)) { # Extract suggested trim from error message - suggested_trim_match <- regmatches(e$message, + suggested_trim_match <- regmatches(e$message, regexpr("consider using this trim: [0-9.]+", e$message)) - + if (length(suggested_trim_match) > 0) { suggested_trim <- as.numeric(sub("consider using this trim: ", "", suggested_trim_match)) - + # Apply a small buffer to ensure success, but cap at max.trim auto_trim <- min(suggested_trim + 0.001, max.trim) - + message(paste("Auto-trimming applied: trim =", round(auto_trim, 4))) message(paste("Reason: Responses don't span the full range from 0 to 1")) - + # Try again with calculated trim tsk(input, control = control, trim = auto_trim, conf.level = conf.level, use.log.doses = use.log.doses, ...) @@ -133,7 +179,7 @@ tsk_auto.data.frame <- function(x, control = 0, conf.level = 0.95, stop(e) } }) - + return(result) } diff --git a/dev/new_function_dev/SK_TSK.qmd b/dev/new_function_dev/SK_TSK.qmd new file mode 100644 index 0000000..91c4d7f --- /dev/null +++ b/dev/new_function_dev/SK_TSK.qmd @@ -0,0 +1,459 @@ +--- +title: "SK_TSK" +format: html +--- + +Great idea. Below are two deliverables: + +1) A minimal patch for drcHelper:::tsk_auto to auto-trim when use.log.doses = TRUE and there is a zero dose, so you avoid degenerate results from log10(0). I show exactly where to add it. + +2) A helper function to tidy outputs from multiple SK/TSK functions and return a single comparison table. + +PATCH: drcHelper:::tsk_auto.data.frame +Where to add: +- Open the source for tsk_auto.data.frame (the one you pasted). +- Right after input <- x and the max.trim validation, insert the block labeled ADD THIS BLOCK. +- Optional but recommended: sanitize ... to drop a user-supplied trim in tsk_auto (prevents “formal argument matched by multiple actual arguments”). + +Patched function body excerpt (only the changed/added lines shown) + +```{r} +tsk_auto.data.frame <- function(x, control = 0, conf.level = 0.95, + use.log.doses = TRUE, max.trim = 0.45, ...) { + input <- x + + # Optional: strip 'trim' from ... to avoid duplicate matching if user passes it to tsk_auto + dots <- list(...) + if (!is.null(dots$trim)) { + warning("tsk_auto ignores 'trim'. Use drcHelper::tsk(...) for explicit trims. Removing 'trim' from ...") + dots$trim <- NULL + } + + # Validate max.trim + if (max.trim <= 0 || max.trim >= 0.5) { + stop("max.trim must be between 0 and 0.5 (exclusive).") + } + + # ADD THIS BLOCK: preemptively trim if log-doses requested and zero (or negative) doses exist + if (isTRUE(use.log.doses) && any(input$x <= 0, na.rm = TRUE)) { + # Minimal safe trim: roughly 1/min(total per dose), capped by max.trim + # Falls back to 0.001 if totals are missing + base_trim <- tryCatch(1 / max(input$n, na.rm = TRUE), error = function(e) NA_real_) + if (!is.finite(base_trim) || base_trim <= 0) base_trim <- 0.001 + auto_trim <- min(base_trim, max.trim) + + message(sprintf("tsk_auto: zero dose with log transform detected; applying auto-trim = %.4f", auto_trim)) + # Try trimmed call; if it fails with a “suggested trim” message, upgrade trim slightly (capped) + return(tryCatch( + do.call(tsk, c(list(input, control = control, trim = auto_trim, conf.level = conf.level, + use.log.doses = use.log.doses), dots)), + error = function(e) { + if (grepl("consider using this trim:", e$message)) { + suggested_trim_match <- regmatches(e$message, regexpr("consider using this trim: [0-9.]+", e$message)) + if (length(suggested_trim_match) > 0) { + suggested_trim <- as.numeric(sub("consider using this trim: ", "", suggested_trim_match)) + auto_trim2 <- min(suggested_trim + 0.001, max.trim) + message(sprintf("tsk_auto: increasing auto-trim to %.4f due to suggestion", auto_trim2)) + return(do.call(tsk, c(list(input, control = control, trim = auto_trim2, conf.level = conf.level, + use.log.doses = use.log.doses), dots))) + } + } + stop(e) + } + )) + } + + # ORIGINAL try with trim=0 (unchanged), but now use 'dots' to avoid duplicate arg names + result <- tryCatch({ + do.call(tsk, c(list(input, control = control, trim = 0, conf.level = conf.level, + use.log.doses = use.log.doses), dots)) + }, error = function(e) { + # Only apply auto-trimming for specific trim-related errors + if (grepl("responses do not increase from trim to 1-trim", e$message)) { + suggested_trim_match <- regmatches(e$message, + regexpr("consider using this trim: [0-9.]+", e$message)) + if (length(suggested_trim_match) > 0) { + suggested_trim <- as.numeric(sub("consider using this trim: ", "", suggested_trim_match)) + auto_trim <- min(suggested_trim + 0.001, max.trim) + message(paste("Auto-trimming applied: trim =", round(auto_trim, 4))) + message(paste("Reason: Responses don't span the full range from 0 to 1")) + do.call(tsk, c(list(input, control = control, trim = auto_trim, conf.level = conf.level, + use.log.doses = use.log.doses), dots)) + } else { + stop(e) + } + } else { + stop(e) + } + }) + + return(result) +} + +``` + +Notes: +- This patch: + - Detects use.log.doses = TRUE with x <= 0, and applies a minimal trim automatically: trim = min(1 / max(n), max.trim), with a lower safeguard of 0.001. + - If tsk() still suggests a larger trim, it bumps it to the suggested value + 0.001 (capped by max.trim). + - Prevents the “formal argument 'trim' matched by multiple actual arguments” error by stripping trim from ... at the start of tsk_auto. + +Comparison table helper (tidy) +Below is a function that: +- Runs your SpearmanKarber_modified +- Runs drcHelper::tsk_auto twice (log and linear) +- Optionally runs drcHelper::tsk with trim = 1/min(n) on the log scale +- Optionally runs ecotoxicology::TSK with A rounded to integral percent to avoid the formatting bug +- Optionally runs ecotoxicology::SpearmanKarber if totals are constant (N) + +It returns a data.frame with comparable columns. + +```{r} +tidy_sk_compare <- function(x, n, r, conf.level = 0.95, + run_tsk_auto_log = TRUE, + run_tsk_auto_linear = TRUE, + run_tsk_log_mintrim = TRUE, + run_ecotox_TSK = TRUE, + run_ecotox_SK = TRUE) { + stopifnot(length(x) == length(n), length(x) == length(r)) + out_rows <- list() + add_row <- function(method, scale, trim_or_A, est, lcl, ucl, log10est = NA_real_, sd = NA_real_, + gsd = NA_real_, notes = NA_character_) { + out_rows[[length(out_rows) + 1]] <<- data.frame( + method = method, + scale = scale, + trim_or_A = trim_or_A, + log10LC50 = log10est, + LC50 = est, + LCL = lcl, + UCL = ucl, + SD = sd, + GSD = gsd, + notes = notes, + stringsAsFactors = FALSE + ) + } + # 1) Your modified + skm <- try(SpearmanKarber_modified(x, r, n, conf.level = conf.level, retData = TRUE), silent = TRUE) + if (!inherits(skm, "try-error")) { + add_row("SpearmanKarber_modified", "log-dose", NA, + est = skm$LC50, + lcl = skm$confidenceIntervalLC50[1], + ucl = skm$confidenceIntervalLC50[2], + log10est = skm$log10LC50, + sd = if (!is.null(skm$StandardDeviationOfm)) skm$StandardDeviationOfm else NA_real_, + notes = "") + } else { + add_row("SpearmanKarber_modified", "log-dose", NA, NA, NA, NA, NA, NA, NA, as.character(skm)) + } + # Helper to extract from drcHelper::tsk/tsk_auto objects + extract_tsk_like <- function(obj) { + # Try common fields; fall back to NA + est <- obj$LD50 %||% obj$ED50 %||% obj$estimate %||% NA_real_ + lcl <- (obj$conf.int %||% obj$ci %||% c(NA_real_, NA_real_))[1] + ucl <- (obj$conf.int %||% obj$ci %||% c(NA_real_, NA_real_))[2] + sd <- obj$sd %||% obj$SE %||% NA_real_ + gsd <- obj$GSD %||% obj$gsd %||% NA_real_ + list(est = as.numeric(est), lcl = as.numeric(lcl), ucl = as.numeric(ucl), + sd = as.numeric(sd), gsd = as.numeric(gsd)) + } + `%||%` <- function(a, b) if (!is.null(a)) a else b + + # 2) tsk_auto (log-dose) - uses your patched behavior + if (isTRUE(run_tsk_auto_log)) { + o <- try(drcHelper::tsk_auto(data.frame(x = x, n = n, r = r), + control = 0, conf.level = conf.level, + use.log.doses = TRUE), silent = TRUE) + if (!inherits(o, "try-error")) { + ex <- extract_tsk_like(o) + add_row("tsk_auto", "log-dose", attr(o, "trim") %||% NA, + est = ex$est, lcl = ex$lcl, ucl = ex$ucl, + log10est = if (is.finite(ex$est) && ex$est > 0) log10(ex$est) else NA_real_, + sd = ex$sd, gsd = ex$gsd, + notes = "") + } else { + add_row("tsk_auto", "log-dose", NA, NA, NA, NA, NA, NA, NA, as.character(o)) + } + } + # 3) tsk_auto (linear-dose) + if (isTRUE(run_tsk_auto_linear)) { + o <- try(drcHelper::tsk_auto(data.frame(x = x, n = n, r = r), + control = 0, conf.level = conf.level, + use.log.doses = FALSE), silent = TRUE) + if (!inherits(o, "try-error")) { + ex <- extract_tsk_like(o) + add_row("tsk_auto", "linear-dose", attr(o, "trim") %||% NA, + est = ex$est, lcl = ex$lcl, ucl = ex$ucl, + log10est = if (is.finite(ex$est) && ex$est > 0) log10(ex$est) else NA_real_, + sd = ex$sd, gsd = ex$gsd, + notes = "") + } else { + add_row("tsk_auto", "linear-dose", NA, NA, NA, NA, NA, NA, NA, as.character(o)) + } + } + # 4) tsk with minimal trim on log-dose + if (isTRUE(run_tsk_log_mintrim)) { + trim_min <- 1 / max(n, na.rm = TRUE) + o <- try(drcHelper::tsk(x, n, r, trim = trim_min, use.log.doses = TRUE), silent = TRUE) + if (!inherits(o, "try-error")) { + ex <- extract_tsk_like(o) + add_row("tsk (min trim)", "log-dose", trim_min, + est = ex$est, lcl = ex$lcl, ucl = ex$ucl, + log10est = if (is.finite(ex$est) && ex$est > 0) log10(ex$est) else NA_real_, + sd = ex$sd, gsd = ex$gsd, + notes = "") + } else { + add_row("tsk (min trim)", "log-dose", trim_min, NA, NA, NA, NA, NA, NA, as.character(o)) + } + } + # 5) ecotoxicology::TSK with A rounded to integer percent + if (isTRUE(run_ecotox_TSK)) { + A_intpct <- round(100 * (1 / max(n, na.rm = TRUE))) + A <- A_intpct / 100 + o <- try(ecotoxicology::TSK(x, r, n, A = A, conf = conf.level), silent = TRUE) + if (!inherits(o, "try-error")) { + # Try common names used by ecotoxicology::TSK + est <- o$LD50 %||% o$ED50 %||% o$estimate %||% NA_real_ + ci <- o$conf.int %||% o$ci %||% c(NA_real_, NA_real_) + add_row("ecotox::TSK", "log-dose", A, + est = as.numeric(est), + lcl = as.numeric(ci[1]), + ucl = as.numeric(ci[2]), + log10est = if (is.finite(est) && est > 0) log10(as.numeric(est)) else NA_real_, + sd = o$sd %||% o$SE %||% NA_real_, + notes = "") + } else { + add_row("ecotox::TSK", "log-dose", A, NA, NA, NA, NA, NA, NA, as.character(o)) + } + } + # 6) ecotoxicology::SpearmanKarber (only if totals constant) + if (isTRUE(run_ecotox_SK) && length(unique(n)) == 1L) { + # Use positive x to avoid log10(0) inside; provide third column as r/N (observed prop) + use <- which(x > 0) + toxData <- cbind(x[use], r[use], r[use] / n[use]) + o <- try(ecotoxicology::SpearmanKarber(toxData, N = unique(n)[1], retData = TRUE, + showOutput = FALSE, showPlot = FALSE), silent = TRUE) + if (!inherits(o, "try-error")) { + add_row("ecotox::SpearmanKarber", "log-dose", NA, + est = o$LC50, + lcl = o$confidenceInterval95LC50[1], + ucl = o$confidenceInterval95LC50[2], + log10est = o$log10LC50, + sd = if (!is.null(o$varianceOfm)) sqrt(o$varianceOfm) else NA_real_, + notes = "") + } else { + add_row("ecotox::SpearmanKarber", "log-dose", NA, NA, NA, NA, NA, NA, NA, as.character(o)) + } + } + # Bind rows + do.call(rbind, out_rows) +} +``` + + +How to use: +- After adding the tsk_auto patch, source both functions, then: + res <- tidy_sk_compare(x, n, r, conf.level = 0.95) + print(res) + +This will give you a single table with method, scale, trim/A, LC50, CI, and log10(LC50) where available, enabling quick side-by-side comparison. + +If you want me to extend the tidier to include the raw adjusted mortality vectors or more diagnostics (e.g., whether smoothing/trimming occurred), I can add those columns too. + + +Thanks. I’ll give you two things: + +1) A corrected add_row plus a set of separate extract_* functions that return one standardized row each. You can rbind these rows to build your comparison table. + +2) A concise patch for drcHelper:::tsk_auto.data.frame to auto-trim when use.log.doses = TRUE and x includes 0 (or negative), with the exact spot to add it. + +Part 1: add_row and extract functions +Use this add_row that returns the updated out_rows list (no <<-). Then use the extract_* functions below. Each returns a single-row data.frame with columns: +method, scale, trim_or_A, log10LC50, LC50, LCL, UCL, SD, GSD, notes. + +```{r} +add_row <- function(out_rows, method, scale, trim_or_A, est, lcl, ucl, + log10est = NA_real_, sd = NA_real_, gsd = NA_real_, + notes = NA_character_) { + out_rows[[length(out_rows) + 1]] <- data.frame( + method = method, + scale = scale, + trim_or_A = trim_or_A, + log10LC50 = log10est, + LC50 = est, + LCL = lcl, + UCL = ucl, + SD = sd, + GSD = gsd, + notes = notes, + stringsAsFactors = FALSE + ) + out_rows +} + +# Single-row constructor (useful if you prefer not to manage an out_rows list) +standard_row <- function(method, scale, trim_or_A, est, lcl, ucl, + log10est = NA_real_, sd = NA_real_, gsd = NA_real_, + notes = NA_character_) { + data.frame( + method = method, + scale = scale, + trim_or_A = trim_or_A, + log10LC50 = log10est, + LC50 = est, + LCL = lcl, + UCL = ucl, + SD = sd, + GSD = gsd, + notes = notes, + stringsAsFactors = FALSE + ) +} + +extract_SpearmanKarber_modified <- function(skm) { + if (inherits(skm, "try-error")) { + return(standard_row("SpearmanKarber_modified", "log-dose", NA, + est = NA_real_, lcl = NA_real_, ucl = NA_real_, + log10est = NA_real_, sd = NA_real_, gsd = NA_real_, + notes = as.character(skm))) + } + standard_row("SpearmanKarber_modified", "log-dose", NA, + est = skm$LC50, + lcl = skm$confidenceIntervalLC50[1], + ucl = skm$confidenceIntervalLC50[2], + log10est = skm$log10LC50, + sd = if (!is.null(skm$StandardDeviationOfm)) skm$StandardDeviationOfm else NA_real_, + notes = "") +} + +extract_tsk_auto <- function(x, n, r, control = 0, conf.level = 0.95, + use.log.doses = TRUE, max.trim = 0.45) { + obj <- try(drcHelper::tsk_auto(data.frame(x = x, n = n, r = r), + control = control, conf.level = conf.level, + use.log.doses = use.log.doses, max.trim = max.trim), + silent = TRUE) + if (inherits(obj, "try-error")) { + return(standard_row("tsk_auto", if (use.log.doses) "log-dose" else "linear-dose", NA, + est = NA_real_, lcl = NA_real_, ucl = NA_real_, + log10est = NA_real_, sd = NA_real_, gsd = NA_real_, + notes = as.character(obj))) + } + est <- if (!is.null(obj$LD50)) obj$LD50 else if (!is.null(obj$ED50)) obj$ED50 else NA_real_ + ci <- if (!is.null(obj$conf.int)) obj$conf.int else if (!is.null(obj$ci)) obj$ci else c(NA_real_, NA_real_) + sd <- if (!is.null(obj$sd)) obj$sd else if (!is.null(obj$SD)) obj$SD else NA_real_ + gsd <- if (!is.null(obj$GSD)) obj$GSD else if (!is.null(obj$gsd)) obj$gsd else NA_real_ + trim_val <- if (!is.null(obj$trim)) obj$trim else if (!is.null(attr(obj, "trim"))) attr(obj, "trim") else NA_real_ + standard_row("tsk_auto", if (use.log.doses) "log-dose" else "linear-dose", trim_val, + est = est, + lcl = ci[1], + ucl = ci[2], + log10est = if (is.finite(est) && est > 0) log10(est) else NA_real_, + sd = sd, + gsd = gsd, + notes = "") +} + +extract_tsk <- function(x, n, r, trim = 0, use.log.doses = TRUE) { + obj <- try(drcHelper::tsk(x, n, r, trim = trim, use.log.doses = use.log.doses), silent = TRUE) + if (inherits(obj, "try-error")) { + return(standard_row("tsk", if (use.log.doses) "log-dose" else "linear-dose", trim, + est = NA_real_, lcl = NA_real_, ucl = NA_real_, + log10est = NA_real_, sd = NA_real_, gsd = NA_real_, + notes = as.character(obj))) + } + est <- if (!is.null(obj$LD50)) obj$LD50 else if (!is.null(obj$ED50)) obj$ED50 else NA_real_ + ci <- if (!is.null(obj$conf.int)) obj$conf.int else if (!is.null(obj$ci)) obj$ci else c(NA_real_, NA_real_) + sd <- if (!is.null(obj$sd)) obj$sd else if (!is.null(obj$SD)) obj$SD else NA_real_ + gsd <- if (!is.null(obj$GSD)) obj$GSD else if (!is.null(obj$gsd)) obj$gsd else NA_real_ + standard_row("tsk", if (use.log.doses) "log-dose" else "linear-dose", trim, + est = est, + lcl = ci[1], + ucl = ci[2], + log10est = if (is.finite(est) && est > 0) log10(est) else NA_real_, + sd = sd, + gsd = gsd, + notes = "") +} + +extract_ecotox_TSK <- function(x, n, r, A = NULL, conf = 0.95) { + if (is.null(A)) { + A_intpct <- round(100 * (1 / max(n, na.rm = TRUE))) + A <- A_intpct / 100 + } + obj <- try(ecotoxicology::TSK(x, r, n, A = A, conf = conf), silent = TRUE) + if (inherits(obj, "try-error")) { + return(standard_row("ecotox::TSK", "log-dose", A, + est = NA_real_, lcl = NA_real_, ucl = NA_real_, + log10est = NA_real_, sd = NA_real_, gsd = NA_real_, + notes = as.character(obj))) + } + est <- if (!is.null(obj$LD50)) obj$LD50 else if (!is.null(obj$ED50)) obj$ED50 else NA_real_ + ci <- if (!is.null(obj$conf.int)) obj$conf.int else if (!is.null(obj$ci)) obj$ci else c(NA_real_, NA_real_) + sd <- if (!is.null(obj$sd)) obj$sd else if (!is.null(obj$SE)) obj$SE else NA_real_ + standard_row("ecotox::TSK", "log-dose", A, + est = est, + lcl = ci[1], + ucl = ci[2], + log10est = if (is.finite(est) && est > 0) log10(est) else NA_real_, + sd = sd, + gsd = NA_real_, + notes = "") +} + +extract_ecotox_SpearmanKarber <- function(x, n, r) { + if (length(unique(n)) != 1L) { + return(standard_row("ecotox::SpearmanKarber", "log-dose", NA, + est = NA_real_, lcl = NA_real_, ucl = NA_real_, + log10est = NA_real_, sd = NA_real_, gsd = NA_real_, + notes = "Requires constant N")) + } + use <- which(x > 0) + toxData <- cbind(x[use], r[use], r[use] / n[use]) + obj <- try(ecotoxicology::SpearmanKarber(toxData, N = unique(n)[1], + retData = TRUE, showOutput = FALSE, showPlot = FALSE), + silent = TRUE) + if (inherits(obj, "try-error")) { + return(standard_row("ecotox::SpearmanKarber", "log-dose", NA, + est = NA_real_, lcl = NA_real_, ucl = NA_real_, + log10est = NA_real_, sd = NA_real_, gsd = NA_real_, + notes = as.character(obj))) + } + sd_log <- if (!is.null(obj$varianceOfm)) sqrt(obj$varianceOfm) else NA_real_ + standard_row("ecotox::SpearmanKarber", "log-dose", NA, + est = obj$LC50, + lcl = obj$confidenceInterval95LC50[1], + ucl = obj$confidenceInterval95LC50[2], + log10est = obj$log10LC50, + sd = sd_log, + gsd = NA_real_, + notes = "") +} + +# Example combining rows +tidy_compare <- function(x, n, r, conf.level = 0.95) { + rows <- list() + # your modified (object creation) + skm <- try(SpearmanKarber_modified(x, r, n, conf.level = conf.level, retData = TRUE), silent = TRUE) + rows[[length(rows) + 1]] <- extract_SpearmanKarber_modified(skm) + rows[[length(rows) + 1]] <- extract_tsk_auto(x, n, r, control = 0, conf.level = conf.level, use.log.doses = TRUE) + rows[[length(rows) + 1]] <- extract_tsk_auto(x, n, r, control = 0, conf.level = conf.level, use.log.doses = FALSE) + rows[[length(rows) + 1]] <- extract_tsk(x, n, r, trim = 1 / max(n), use.log.doses = TRUE) + rows[[length(rows) + 1]] <- extract_ecotox_TSK(x, n, r, A = 1 / max(n), conf = conf.level) + rows[[length(rows) + 1]] <- extract_ecotox_SpearmanKarber(x, n, r) + do.call(rbind, rows) +} +``` + + + + +And in the original tryCatch that calls tsk with trim = 0, replace direct tsk(...) with do.call(tsk, c(list(...), dots)) so that any other arguments in ... are preserved without conflicting names. + +Where exactly to add: +- In the body of tsk_auto.data.frame, after input <- x and the max.trim check, insert the patch block. +- Also add the optional dots-handling lines at the same location (above the patch block). +- In the existing result <- tryCatch({ ... }, ...), move from direct tsk(...) to do.call(tsk, c(list(...), dots)). + +This ensures: +- tsk_auto automatically trims when log doses include zero, preventing degenerate estimates. +- Users won’t hit the “formal argument 'trim' matched by multiple actual arguments” error in tsk_auto. diff --git a/man/SpearmanKarber_modified.Rd b/man/SpearmanKarber_modified.Rd new file mode 100644 index 0000000..2f41494 --- /dev/null +++ b/man/SpearmanKarber_modified.Rd @@ -0,0 +1,82 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tests_wrapper.R +\name{SpearmanKarber_modified} +\alias{SpearmanKarber_modified} +\title{Spearman-Karber Estimation with Modified Handling for Control Mortality} +\usage{ +SpearmanKarber_modified( + conc, + dead, + total, + conf.level = 0.95, + retData = TRUE, + showOutput = FALSE, + showPlot = FALSE +) +} +\arguments{ +\item{conc}{A numeric vector of doses or concentrations (must be >= 0 and in increasing order).} + +\item{dead}{A numeric vector of the number of organisms that died or responded at each \code{conc} level.} + +\item{total}{A numeric vector of the total number of organisms (population size) at each \code{conc} level. Can be a single value if all are the same.} + +\item{conf.level}{A single numeric value specifying the confidence level for the interval estimation (e.g., 0.95 for a 95\% CI). Must be in (0, 1).} + +\item{retData}{A logical value. If \code{TRUE}, the results are returned in a list. If \code{FALSE}, \code{invisible(NULL)} is returned.} + +\item{showOutput}{A logical value. If \code{TRUE}, the input data table and estimation results (including log-scale values and CIs) are printed to the console.} + +\item{showPlot}{A logical value. If \code{TRUE}, a plot is generated showing the observed and Abbott-corrected mortalities/responses, the estimated LC50, and its confidence interval.} +} +\value{ +A list containing the estimation results if \code{retData} is \code{TRUE}, otherwise \code{invisible(NULL)}. The list includes: +\item{\code{log10LC50}}{Estimated log10 of the LC50.} +\item{\code{varianceOfLog10LC50}}{Estimated variance of log10LC50.} +\item{\code{StandardDeviationOfm}}{Estimated standard deviation of log10LC50.} +\item{\code{confidenceIntervalLog10}}{CI for log10LC50 (vector of two values).} +\item{\code{LC50}}{Estimated LC50 (10^log10LC50).} +\item{\code{confidenceIntervalLC50}}{CI for LC50 (vector of two values).} +\item{\code{conf.level}}{The confidence level used for the CIs.} +} +\description{ +Estimates the LC50 (median lethal concentration) or ED50 (median effective dose) +and its confidence interval using the Spearman-Karber method. This version includes +robust handling for zero-dose (control) mortality and a Fieller-like approach for +confidence interval estimation when control mortality is non-zero. +} +\details{ +The function operates in two branches: +\itemize{ +\item If control mortality (p0) is near zero, the standard Spearman-Karber method is used on the log-transformed doses, assuming the first observed response is 0\%. +\item If p0 is non-zero, it estimates the background rate (c) by cumulative pooling, Abbott-corrects the proportions, prunes/pools low-dose groups, and uses a modified Spearman-Karber method on the scaled proportions. Confidence intervals are calculated using an approach inspired by Fieller's theorem to account for the background correction uncertainty. +} + +All concentrations must be non-negative and in increasing order. +} +\examples{ +# Example 1: Zero control mortality (standard Spearman-Karber) +x1 <- c(0, 0.2, 0.3, 0.375, 0.625, 2) +n1 <- c(30, 30, 30, 30, 30, 30) +r1 <- c(0, 1, 3, 16, 24, 30) +SpearmanKarber_modified(x1, r1, n1, showOutput = TRUE) + +# Example 2: Non-zero control mortality (modified method) +x2 <- c(0, 15.54, 20.47, 27.92, 35.98, 55.52) +n2 <- c(40, 40, 40, 40, 40, 40) +r2 <- c(3, 2, 6, 11, 18, 33) +results <- SpearmanKarber_modified(x2, r2, n2, retData = TRUE, + showOutput = TRUE, showPlot = TRUE) +print(results$LC50) +} +\references{ +ART CARTER, WYETH-AYERST RESEARCH, CHAZY, NY (1994): Using the Spearman-Karber Method to Estimate the ED50. +Proceedings of the Nineteenth Annual SAS Users Group International Conference, Dallas, Texas, April, pp. 10-13. +\url{http://www.sascommunity.org/sugi/SUGI94/Sugi-94-195\%20Carter.pdf}. +} +\seealso{ +\code{\link[drcHelper]{tsk_auto}} +} +\author{ +Sarah Baumert, Harald Schulz, Zhenglei Gao +} diff --git a/man/analyze_SK.Rd b/man/analyze_SK.Rd new file mode 100644 index 0000000..17b63fd --- /dev/null +++ b/man/analyze_SK.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tests_wrapper.R +\name{analyze_SK} +\alias{analyze_SK} +\title{Unified Spearman-Karber Analysis Function} +\usage{ +analyze_SK(x, n, r, method, conf.level = 0.95, ...) +} +\arguments{ +\item{x}{Numeric vector of concentrations.} + +\item{n}{Numeric vector of total subjects per concentration.} + +\item{r}{Numeric vector of responses (e.g., dead) per concentration.} + +\item{method}{The analysis method to use. Must be one of: +\itemize{ +\item "SK_modified" (your custom SpearmanKarber_modified function) +\item "tsk_auto_log" (drcHelper::tsk_auto with log-doses) +\item "tsk_auto_linear" (drcHelper::tsk_auto with linear doses) +\item "ecotox_SK" (ecotoxicology::SpearmanKarber) +}} + +\item{conf.level}{The confidence level for intervals (default 0.95).} + +\item{...}{Additional arguments passed to the underlying functions (e.g., max.trim for tsk_auto).} +} +\value{ +A single-row data frame containing the standardized analysis results. +} +\description{ +This function serves as a wrapper to run various Spearman-Karber (SK) and +Trimmed Spearman-Karber (TSK) analyses using a single interface. +It returns a standardized one-row data frame for easy comparison. +} +\examples{ +x <- c(0, 0.2, 0.3, 0.375, 0.625, 2) +n <- c(30, 30, 30, 30, 30, 30) +r <- c(0, 1, 3, 16, 24, 30) + +# Run a single analysis +analyze_SK(x, n, r, method = "SK_modified") + +# Run multiple analyses and combine into a single table +methods_to_run <- c("SK_modified", "tsk_auto_log", "tsk_auto_linear", "ecotox_SK") +all_results <- lapply(methods_to_run, function(m) { + analyze_SK(x, n, r, method = m) +}) +comparison_table <- do.call(rbind, all_results) +print(comparison_table) +} diff --git a/man/dunn_test.Rd b/man/dunn_test.Rd new file mode 100644 index 0000000..44757fd --- /dev/null +++ b/man/dunn_test.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dunn_test.R +\name{dunn_test} +\alias{dunn_test} +\title{Dunn's Multiple Comparison Test} +\usage{ +dunn_test( + data, + response_var, + dose_var, + control_level = 0, + alternative = "less", + p_adjust_method = "holm", + alpha = 0.05, + include_kruskal = TRUE +) +} +\arguments{ +\item{data}{A data frame containing the response and grouping variables} + +\item{response_var}{Character string specifying the name of the response variable} + +\item{dose_var}{Character string specifying the name of the dose/treatment variable} + +\item{control_level}{The control level (default: 0)} + +\item{alternative}{Character string specifying the alternative hypothesis. +Must be one of "less", "greater", or "two.sided" (default: "less")} + +\item{p_adjust_method}{Character string specifying the p-value adjustment method +(default: "holm"). See p.adjust.methods for available methods} + +\item{alpha}{Significance level (default: 0.05)} + +\item{include_kruskal}{Logical indicating whether to include Kruskal-Wallis test results +(default: TRUE)} +} +\value{ +A list of class "dunn_test_result" containing: +\describe{ +\item{results_table}{Data frame with comparison results including z-values and p-values} +\item{kruskal_wallis}{Kruskal-Wallis test results (if include_kruskal = TRUE)} +\item{noec}{No Observed Effect Concentration} +\item{noec_message}{Description of NOEC determination} +\item{model_type}{Description of the statistical method used} +\item{control_level}{The control level used} +\item{alpha}{Significance level used} +\item{alternative}{Alternative hypothesis tested} +\item{p_adjust_method}{P-value adjustment method used} +} +} +\description{ +Performs Dunn's multiple comparison test for comparing treatment groups against a control +after a significant Kruskal-Wallis test. This is a wrapper around PMCMRplus::kwManyOneDunnTest +that provides consistent output structure with other drcHelper test functions. +} +\note{ +This function uses PMCMRplus::kwManyOneDunnTest which produces equivalent results +to DescTools::DunnTest. Both implementations use the same underlying statistical +methodology for Dunn's post-hoc test following Kruskal-Wallis. +} +\examples{ +\dontrun{ +# Example data +Rate <- c(0,0,0,0,0,0, + 0.0448,0.0448,0.0448,0.0448, + 0.132,0.132,0.132,0.132) +y <- c(0.131,0.117,0.130,0.122,0.127,0.128, + 0.122,0.126,0.128,0.116, + 0.090,0.102,0.107,0.099) +test_data <- data.frame(Rate = Rate, Response = y) + +# Run Dunn's test +result <- dunn_test(test_data, response_var = "Response", + dose_var = "Rate", control_level = 0, + alternative = "less") +} + +} diff --git a/man/print.dunn_test_result.Rd b/man/print.dunn_test_result.Rd new file mode 100644 index 0000000..6fe2238 --- /dev/null +++ b/man/print.dunn_test_result.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dunn_test.R +\name{print.dunn_test_result} +\alias{print.dunn_test_result} +\title{Print method for dunn_test_result} +\usage{ +\method{print}{dunn_test_result}(x, ...) +} +\arguments{ +\item{x}{A dunn_test_result object} + +\item{...}{Additional arguments (not used)} +} +\description{ +Print method for dunn_test_result +} diff --git a/vignettes/articles/MDD-in-Regulatory-Context.Rmd b/vignettes/articles/MDD-in-Regulatory-Context.Rmd index c3288d8..ce9b4ae 100644 --- a/vignettes/articles/MDD-in-Regulatory-Context.Rmd +++ b/vignettes/articles/MDD-in-Regulatory-Context.Rmd @@ -1,5 +1,7 @@ --- title: "MDD in Regulatory Context" +editor_options: + chunk_output_type: console --- ```{r, include = FALSE} @@ -271,10 +273,40 @@ Usage examples - Williams PMCMRplus (your MOCK0065 Growth Rate): ```{r eval=FALSE} +# Helper to convert dose strings to numeric, handling various formats +convert_dose <- function(x) { + if (length(x) == 0) return(numeric(0)) + xc <- as.character(x) + xc <- trimws(xc) + xc[xc %in% c("", "n/a", "NA")] <- NA_character_ + # Normalize decimal commas and keep scientific notation (e.g., "4,48E-2" -> "4.48E-2") + xc <- gsub(",", ".", xc, fixed = TRUE) + out <- suppressWarnings(as.numeric(xc)) + return(out) +} + +convert_numeric <- function(x) { + if (length(x) == 0) return(numeric(0)) + xc <- as.character(x) + xc <- trimws(xc) + xc[xc %in% c("", "n/a", "NA")] <- NA_character_ + xc <- gsub(",", ".", xc, fixed = TRUE) + suppressWarnings(as.numeric(xc)) +} + +dose_from_comparison <- function(comp_vec) { + if (length(comp_vec) == 0) return(numeric(0)) + vapply(comp_vec, function(s) { + if (is.na(s)) return(NA_real_) + parts <- strsplit(s, " - ", fixed = TRUE)[[1]] + convert_dose(parts[1]) + }, FUN.VALUE = numeric(1)) +} w_ep <- test_cases_data %>% dplyr::filter(`Study ID` == "MOCK0065", Endpoint == "Growth Rate") w_ep$Dose_numeric <- convert_dose(w_ep$Dose) w_ep$Dose_factor <- factor(w_ep$Dose_numeric, levels = sort(unique(w_ep$Dose_numeric))) - +res_william <- broom_williams(Response ~ Dose_factor, data = w_ep, + test = "Williams_PMCMRplus", alpha = 0.05, alternative = "less") mdd_w_pm <- compute_mdd_generic(Response ~ Dose_factor, data = w_ep, test = "Williams_PMCMRplus", alpha = 0.05, alternative = "smaller") print(mdd_w_pm) @@ -307,6 +339,19 @@ Notes and options - You can extend the test argument to include other tests (e.g., “Dunn”) once you define the appropriate Tcrit. Dunn typically uses z critical values; for MDD you would use zcrit × SE_diff on a rank-based scale, which is a different construct; unless your expected MDD% is defined explicitly for Dunn, I recommend sticking to parametric tests above. - If you’d like me to integrate this into your validation report, I can add an MDD% metric branch that uses compute_mdd_generic under the hood and compares to expected “MDD%” rows for Williams. +# Implementation in `drcHelper` + +Reusing existing test objects and building a modular system around them is far more efficient and robust. + +```{r} +library(drcHelper) +Results <- broom_williams(Response ~ factor(Dose), data = dat_medium, + test = "Williams_JG", alpha = 0.05, alternative = "less") + +compute_mdd_williams(Results,data=dat_medium,formula = Response ~ factor(Dose)) +``` + + # Implementation in the Validation for Williams @@ -314,19 +359,25 @@ Notes and options Here's a self-contained helper to compute per-dose MDD% for Williams and return a tidy table. It uses your existing helpers and broom_williams output. -How to integrate into your validation +# How to integrate into the validation workflow - In the Williams run_actual handler, compute the prelim summary as before (for Mean, SD, %Inhibition, CV), and also compute MDD%: +```r prelim <- compute_prelim_summary(endpoint_data) mdd_tbl <- compute_mdd_williams(endpoint_data, alternative = alternative) # Return both; the generic runner can join MDD% when expected rows exist list(actual_df = actual_df, group_means = prelim, mdd = mdd_tbl) +``` - In your expected parsing (parse_expected_metrics for Williams), you already capture "MDD%": -`out$mdd <- pick("\\bMDD%\\b"); names(out$mdd)[2] <- "Expected_MDDpct"`` +```r +out$mdd <- pick("\\bMDD%\\b"); +names(out$mdd)[2] <- "Expected_MDDpct" +``` + - In the generic runner's join stage for Williams, add: @@ -356,11 +407,13 @@ if (!is.null(exp_splits$mdd) && nrow(exp_splits$mdd)) { - The SE_diff above already handles unequal n via 1/n_c + 1/n_t. - If variances are heterogeneous and a Welch-type approach is used, you would estimate SE_diff via group-specific variances. Williams is based on a pooled-variance ANOVA, so the pooled MSE is appropriate here. -**Optional: power-based MDD%** +## Optional: power-based MDD% -- If you later need to compute a power-based MDD% (target power 1−β), use: +- If we later need to compute a power-based MDD% (target power 1−β), use: - $$MDD_{power} = \left(t_{1-\alpha,\ df} + t_{1-\beta,\ df}\right) \cdot SE_{diff}$$ - Then $$MDD\%_{power} = 100 \cdot MDD_{power} / \mu_c$$ - df can be taken from the residual df of the ANOVA model. You can parameterize β (e.g., 0.2 for 80% power) and compute the quantiles using stats::qt. -If you share one Williams study's expected MDD% values and your endpoint_data, I can quickly verify that the compute_mdd_williams output matches to within your tolerance and adjust if the expected MDD% uses a different SE (e.g., contrast-specific SE in Williams instead of the simple (1/n_c + 1/n_t) form). +## Notes + +We probably need to adjust if the expected MDD% uses a different SE (e.g., contrast-specific SE in Williams instead of the simple (1/n_c + 1/n_t) form). diff --git a/vignettes/articles/TSK_method.Rmd b/vignettes/articles/TSK_method.Rmd index 27804a1..689d6fc 100644 --- a/vignettes/articles/TSK_method.Rmd +++ b/vignettes/articles/TSK_method.Rmd @@ -1,5 +1,7 @@ --- title: " Spearman-Karber method" +editor_options: + chunk_output_type: console --- ```{r, include = FALSE} @@ -8,13 +10,303 @@ knitr::opts_chunk$set( comment = "#>" ) source("../knitr-setup.R") +library(drcHelper) ``` ## Backaground -Spearman-Karber method is still in use in regulatory Ecotox endpoints derivation. A more common approach would be derive a EC50 from interpolation by a smoothing line. +Spearman-Karber method is still in use in regulatory Ecotox endpoints derivation under certain scenarios. A more common approach would be derive a EC50 from interpolation by a smoothing line. + +# Various Implementations + +Here is a comparison between `drcHelper::SpearmanKarber_modified`, the original `ecotoxicology::SpearmanKarber`, and the `drcHelper::tsk_auto` (adaptive "trimmed Spearman–Karber"). + +## `drcHelper::SpearmanKarber_modified` vs. `ecotoxicology::SpearmanKarber` + +`drcHelper::SpearmanKarber_modified` is based on a function written by Sarah and Harold. I provided a fixed and refactored version. This revision corrected several subtle bugs related to loop indexing, unsafe handling of log10(0), and hard-coded data sizes, making the function more robust and reliable for generic data. + +In summary, key conceptual differences are: + +* **Monotonicity Handling:** The original `ecotoxicology::SpearmanKarber` uses smoothing, while `drcHelper::SpearmanKarber_modified` uses a more complex method of pruning and pooling data based on an estimated background mortality rate (`c`) when control mortality is positive. +* **Confidence Intervals:** `drcHelper::SpearmanKarber_modified` incorporates Fieller's Theorem for more accurate confidence intervals when control mortality is present, a feature the original lacks. +* **Flexibility:** `drcHelper::SpearmanKarber_modified` was designed to handle variable totals per dose (`n_i`), while the original assumes a constant `N`. + + +## TSK + +The first version of the wrapper function `tsk_auto` only auto-trims if `tsk()` throws a specific trim error. In the case dose 0 is included in the data, tsk() didn't error but returned a degenerate estimate (LD50=0, NaN CI). Turning off logs avoids that.During the comparison I also wrote a small code patch for `drcHelper:::tsk_auto.data.frame` that automatically detects when a log-transform is requested on data with a zero dose and applies a minimal trim to prevent errors. + +`drcHelper:::tsk_auto` prioritizes a monotone, well-behaved response profile by trimming tails rather than smoothing (like the original) or pruning/pooling by a background-rate threshold (like `drcHelper::SpearmanKarber_modified`). + +## Core estimator (all three are Spearman–Karber variants) +- Base SK trapezoid on log-dose: + - $m \equiv \sum_{i} \Delta p_i \cdot \frac{\log_{10} x_i + \log_{10} x_{i+1}}{2}$, where $\Delta p_i = p_{i+1}-p_i$. + - $\mathrm{LC50} = 10^{m}$. +- Differences are how p is preprocessed (Abbott correction, trimming/pruning, smoothing), and how variance/CI are computed. + +### How each method preprocesses p (monotonicity and control mortality) +- ecotoxicology::SpearmanKarber (original): + - If proportions aren't monotone, it smooths them to a non-decreasing sequence, then applies Abbott's correction. + - Single N assumed; uses that in the variance. +- SpearmanKarber_modified (drcHelper): + - Always does Abbott-like correction from the control (explicit). + - $p_i^{A} = \frac{p_i - p_0}{1 - p_0}$, with $p_i = r_i/n_i$. + - If p0=0: add "ghost" endpoints with p=0 and p=1 at extrapolated log-doses; integrate over the full [0,1]. + - If p0>0: estimate background mortality c by pooled cumulative minimum: + - $c = \min_k \frac{\sum_{i=1}^k r_i}{\sum_{i=1}^k n_i}$, with $n_c $the pooled denominator at the argmin. + - Pool doses with p_i 0: + - After pruning and rescaling to $\tilde p$, compute raw trapezoid: + - $\mu^{\mathrm{raw}} = \sum_{i=1}^{m} (\tilde{p}_{i+1}-\tilde{p}_i)\cdot \frac{\log_{10}x_i+\log_{10}x_{i+1}}{2}$. + - Adjust back for c using the first-segment midpoint $a = \frac{\log_{10}x_0+\log_{10}x_1}{2}$: + - $\mu = \frac{\mu^{\mathrm{raw}} - c\,a}{1 - c}$, $\mathrm{LC50}=10^\mu$. +- tsk_auto (trimmed SK): + - With indices L..U after trim and renormalized $\tilde p$: + - $\mu_{TSK} = \sum_{i=L}^{U-1} (\tilde{p}_{i+1}-\tilde{p}_i)\cdot \frac{\log_{10}x_i+\log_{10}x_{i+1}}{2}$, + - $\mathrm{LC50}=10^{\mu_{TSK}}$. + +#### Variance and confidence intervals + +- Original `ecotoxicology::SpearmanKarber`: + - $V_m = \sum_{i=2}^{n-1} \Delta p_i(1-\Delta p_i)\cdot \frac{(\log_{10}x_{i+1}-\log_{10}x_{i-1})^2}{4N-4} $(constant N). + - 95% CI: $m \pm 2\sqrt{V_m}$; back-transform to LC50. +- Modified `drcHelper::SpearmanKarber_modified`, p0=0: + - Per-dose n_i: $\operatorname{Var}(\mu) = \sum_{i=2}^{n-1} 0.25(\log_{10}x_{i-1}-\log_{10}x_{i+1})^2 \frac{p_i(1-p_i)}{n_i}$. + - CI: $\mu \pm z_{1-\alpha/2}\sqrt{\operatorname{Var}(\mu)}$. +- Modified `drcHelper::SpearmanKarber_modified`, p0>0 (Fieller on log-scale): + - Define $V_{12} = \left(\frac{\log_{10} x_0 + \log_{10} x_1}{2}\right)^2 \frac{c(1-c)}{n_c}$, $V_{22} = \frac{c(1-c)}{n_c}$, $V_{11} = \operatorname{Var}(\mu)+V_{12}$. + - With $z=z_{1-\alpha/2}$, $B=1-c$, $g=\frac{z^2V_{22}}{B^2}$: + - $\sigma = \frac{z}{B} \cdot \frac{\sqrt{V_{11}-2\mu V_{12}+\mu^2V_{22}-g\left(V_{11}-\frac{V_{12}^2}{V_{22}}\right)}}{1-g}$, + - CI: $\mu - \frac{gV_{12}}{V_{22}} \pm \sigma$; back-transform. +- tsk_auto (`drcHelper::tsk_auto`, typical TSK): + - Uses the same normal-approx SK variance as your p0=0 branch but on the trimmed-and-renormalized grid: + - $\operatorname{Var}(\mu_{TSK}) = \sum_{i=L+1}^{U-1} 0.25(\log_{10}x_{i-1}-\log_{10}x_{i+1})^2 \frac{\tilde p_i(1-\tilde p_i)}{n_i}$, + - CI: $\mu_{TSK} \pm z_{1-\alpha/2}\sqrt{\operatorname{Var}(\mu_{TSK})}$. + - Fieller is generally not used in trimmed SK; CIs are normal-approx based on the trimmed segment. + +### Key contrasts: tsk_auto vs modified vs original +- Handling non-monotonicity: + - tsk_auto: trims tails and renormalizes; data-driven trim chosen automatically. + - Modified: either uses ghost endpoints (p0=0) or prunes doses below a data-driven c and rescales (p0>0). + - Original: smooths to enforce monotonic increase then applies Abbott. +- Control mortality: + - tsk_auto: supplies control dose (control=0 by default). The underlying tsk typically corrects via the control or excludes it when trimming. It does not estimate a background c via cumulative pooling. + - Modified: explicit Abbott correction and, if p0>0, a pooled minimum estimator of background c, plus Fieller CIs. + - Original: Abbott after smoothing (single N). +- Log transformation: + - tsk_auto: can turn log-doses on/off via use.log.doses; practical when x includes a 0 dose (control). + - Modified: always uses log10; explicitly creates ghost endpoints to avoid depending on log10(0). + - Original: uses log10 internally; relies on na.rm=TRUE to avoid log10(0) breaks if present. +- Variance/CI: + - tsk_auto: normal-approx on the trimmed/renormalized grid, per-dose n_i. + - Modified: normal-approx for p0=0; Fieller when p0>0. + - Original: constant-N variance and a fixed "2" multiplier for 95% CI. + +### Practical guidance + +- If you want robust, minimal-tuning monotone behavior with potentially messy tails: tsk_auto is convenient; it chooses a trim that makes the estimation feasible and stable, avoids over-influence of outlying tails, and respects variable n_i. +- If nonzero control mortality is a concern and you want a background-rate-aware estimate with Fieller CIs: your modified function targets that scenario directly. +- If your totals are constant and you prefer smoothing to trimming or pruning: the original function is simplest. + + +### How results will typically differ from tsk_auto +- When control mortality > 0: + - `drcHelper::SpearmanKarber_modified` estimates c by pooled cumulative minima and applies Fieller CIs; tsk_auto trims instead, then uses normal-approx CIs. Estimates and CIs will differ, especially if early-dose mortalities fluctuate around the background. +- When tails are noisy: + - tsk_auto will remove tail influence via trim; your modified (p0=0) keeps full range but adds ghost endpoints; the original smooths instead. Trimming usually reduces variance and sensitivity to extreme tail spacing. +- With variable totals n_i: + - Both tsk_auto and `drcHelper::SpearmanKarber_modified` use per-dose n_i in variance; the `ecotoxicolog::SpearmanKarber` assumes constant N and may misstate precision when n_i vary. + + + +```{r} +## install.packages("isotone") +## devtools::install_github(repo="brsr/tsk") + +library(drcHelper) +## library(tsk) +tsk(c(1, 10, 100, 1000), 20, c(0, 3, 17, 20)) + +data(hamilton) + + +``` + + +```{r} +x<-c(0,0.2,0.3,0.375,0.625,2) +n<-c(30,30,30,30,30,30) +r<-c(0,1,3,16,24,30) +skm <- SpearmanKarber_modified(x,r,n) +skm +tsk_auto(x,n,r, use.log.doses = FALSE) +tsk_auto(x,n,r, use.log.doses = TRUE) + +drcHelper::tsk(x, n, r, trim = 1/30, use.log.doses = FALSE) +drcHelper::tsk(x, n, r, trim = 1/30, use.log.doses = TRUE) + + +## ecotoxicology::TSK errored for A=0, suggesting A ≥ 1/30 ≈ 0.033333… to make the response span usable for trimming. +## A = 0.0333 failed due to a formatting bug in that version; use A that makes A*100 an integer (e.g., 0.04). +ecotoxicology::TSK(x*100, r, n, A = 0.04, conf = 0.95) +p <- r/n +x2 <- x +x2[1] <- 1e-1 ## replace it with very small values. +ecotoxicology::SpearmanKarber(cbind(x2,r,p),N=30, retData = FALSE, showOutput = TRUE,showPlot = FALSE) +ecotoxicology::SpearmanKarber(cbind(x2,r,n),N=30, retData = FALSE, showOutput = TRUE,showPlot = FALSE) + +## remove 0 dose +ecotoxicology::SpearmanKarber(cbind(x[-1],r[-1],p[-1]),N=30, retData = TRUE, showOutput = TRUE,showPlot = FALSE) + + +x=c(0,15.54,20.47,27.92,35.98,55.52) +n=c(40,40,40,40,40,40) +r=c(3,2,6,11,18,33) + +ecotoxicology::SpearmanKarber(cbind(x,r,n),N=30, retData = FALSE, showOutput = TRUE,showPlot = FALSE) + +``` + + + +```{r} +# Your data +x <- c(0, 0.2, 0.3, 0.375, 0.625, 2) +n <- c(30, 30, 30, 30, 30, 30) +r <- c(0, 1, 3, 16, 24, 30) + +# Create a master comparison function +tidy_compare <- function(x, n, r, conf.level = 0.95) { + + # A list to hold the output rows + all_rows <- list() + + # Call each extract function and add the result to the list + all_rows[[length(all_rows) + 1]] <- drcHelper:::extract_SpearmanKarber_modified(x, n, r, conf.level) + all_rows[[length(all_rows) + 1]] <- drcHelper:::extract_tsk_auto(x, n, r, use.log.doses = TRUE, conf.level) + all_rows[[length(all_rows) + 1]] <- drcHelper:::extract_tsk_auto(x, n, r, use.log.doses = FALSE, conf.level) + all_rows[[length(all_rows) + 1]] <- drcHelper:::extract_ecotox_SpearmanKarber(x, n, r) + + # You can easily add more functions here, e.g.: + # all_rows[[length(all_rows) + 1]] <- extract_ecotox_TSK(x, n, r, conf = conf.level) + + # Combine all the single-row data frames into one table + do.call(rbind, all_rows) +} + +# Run the comparison +comparison_table <- tidy_compare(x, n, r) + +# Print the final result +## print(comparison_table) +comparison_table %>% knitr::kable(.,digits = 3) +``` + + +#### Using the wrapper `analyze_SK` function + +```{r} +# Your data +x <- c(0, 0.2, 0.3, 0.375, 0.625, 2) +n <- c(30, 30, 30, 30, 30, 30) +r <- c(0, 1, 3, 16, 24, 30) + +# Define the methods you want to run +methods_to_run <- c("SK_modified", "tsk_auto_log", "tsk_auto_linear", "ecotox_SK") + +# Use lapply to run the analysis for each method +all_results <- lapply(methods_to_run, function(m) { + # The ... argument lets you pass method-specific options here if needed + # e.g., analyze_SK(x, n, r, method = m, max.trim = 0.4) + analyze_SK(x, n, r, method = m) +}) + +# Combine the list of single-row data frames into one final table +comparison_table <- do.call(rbind, all_results) + +# Print the result +print(comparison_table) +``` + + + +- All three valid SK variants (your modified, TSK with A ≈ 0.0333 and use.log.doses = FALSE, and original SpearmanKarber with N = 30) should give very similar LC50 near 0.45 because responses increase cleanly from 0 to 1 across doses. +- Minor differences can arise from: + - Whether ghost endpoints or trimming are used, + - Variance/CI formulas (Fieller vs normal approximation), + - Whether logs are used with a zero-dose control. + +## Notes on GSD and SD_log10 -## Method +This is related to how we describe uncertainty for log-normal data, and it's a frequent point of confusion. + +In short: **They both measure the exact same amount of uncertainty**, but they express it on different scales. + +* `SD_log10` is **additive** on the **log10 scale**. +* `GSD` is **multiplicative** on the **original concentration scale**. + +### SD_log10: The Standard Deviation of the log10(LC50) + +This is the more straightforward statistical measure. When we perform Spearman-Karber analysis, we are actually estimating the mean of the distribution of the *logarithms* of the toxic thresholds. + +* **What it is:** The standard deviation of our `log10LC50` estimate. If our estimate is $m = \log_{10}(\text{LC50})$, then `SD_log10` is the standard deviation of $m$. +* **How it's used:** It is used to construct a confidence interval *on the log10 scale*. You add and subtract this value (multiplied by a z-score like 1.96) to get your confidence limits. + $\text{95% CI for } \log_{10}(\text{LC50}) = m \pm 1.96 \times \text{SD}_{\log_{10}}$ + +### GSD: The Geometric Standard Deviation + +The GSD is a more intuitive way to express this same uncertainty back on the original concentration scale. Since the underlying distribution is log-normal, the spread is multiplicative, not additive. + +* **What it is:** A unitless factor that describes how spread out the data are on the original scale. +* **How it's derived:** It is the exponentiated standard deviation from the log scale. The relationship depends on the base of the logarithm used. + * If using natural log (`ln`), then `GSD` = $e^{\text{SD}_{\ln}}$. The `drcHelper` package uses this convention. + * To be consistent with our `SD_log10`, we can define a base-10 GSD as: + $\text{GSD} = 10^{\text{SD}_{\log_{10}}}$ + And conversely: + $\text{SD}_{\log_{10}} = \log_{10}(\text{GSD})$ + +* **How it's used:** It is used to construct a confidence interval by **multiplying and dividing** the LC50 estimate. + $\text{95% CI for LC50} = \text{LC50} \times / \div (\text{GSD})^{1.96}$ + Which means the lower bound is $\text{LC50} / (\text{GSD})^{1.96} $and the upper bound is $\text{LC50} \times (\text{GSD})^{1.96}$. +* **Analogy:** Instead of saying "the true value is plus or minus 10 mg/L," you'd say "the true value is likely within a **factor of 2** of our estimate." In this case, the GSD would be 2. + + +### Summary Table + +| Feature | `SD_log10` | `GSD` (Geometric Standard Deviation) | +| :--- | :--- | :--- | +| **Scale** | Logarithmic | Original (Concentration) | +| **Operation** | **Additive** (±) | **Multiplicative** (×/÷) | +| **Units** | log10(concentration units) | None (it's a factor) | +| **CI on Log Scale** | `log(LC50) ± z * SD_log10` | Not used directly | +| **CI on Original Scale** | Back-transform the log CI | `LC50 ×/÷ (GSD)^z` | +| **Interpretation** | "The uncertainty is ±0.03 units on the log10 scale." | "The uncertainty is by a factor of 1.08 on the original scale." | + +The reason both columns exist in our summary table is that different functions naturally report one or the other. `SpearmanKarber_modified` calculates `SD_log10`, while `drcHelper::tsk_auto` reports the `GSD`. By calculating the corresponding value for each, our table allows for a direct, apples-to-apples comparison of the uncertainty calculated by each method. + + + +## Some Notes + +`tsk` function comes from the R package. Since it is a single function without dependencies, it is bundled into this helper package for the purpose of validation and verification. + +The original goal of this R package was to replicate the results of a DOS program that used to be provided by the EPA to perform the trimmed Spearman-Karber method. The list "expected" contains the results of that DOS program run on the data from Hamilton et al. Some of these are NA because the EPA program didn't return a result. The EPA program uses a confidence of 2*pnorm(2)-1=0.9544997 (that is, exactly two sigmas on both sides). + + +## Other Methods Two commonly used methods for calculating 50% endpoint using serial dilutions are Spearman-Karber method and Reed and Muench method. @@ -24,7 +316,7 @@ The original paper written by Kärber was published in 1931 and is in German [K log10 50% end point dilution = log10 of dilution showing a mortality next above 50% - (difference of logarithms × logarithm of dilution factor). -Generally, the following formula is used to calculate “difference of logarithms” (difference of logarithms is also known as “proportionate distance” or “interpolated value”): Difference of logarithms = [(mortality at dilution next above 50%)-50%]/[(mortality next above 50%)-(mortality next below 50%)]. +Generally, the following formula is used to calculate "difference of logarithms" (difference of logarithms is also known as "proportionate distance" or "interpolated value"): Difference of logarithms = [(mortality at dilution next above 50%)-50%]/[(mortality next above 50%)-(mortality next below 50%)]. ### Spearman-Karber method @@ -50,25 +342,6 @@ Formula 2 (if any accidental death occurred): log10 50% end point dilution = -(total death score + 0.5) × log dilution factor. -## Some Notes - -`tsk` function comes from the R package. Since it is a single function without dependencies, it is bundled into this helper package for the purpose of validation and verification. - - -The original goal of this R package was to replicate the results of a DOS program that used to be provided by the EPA to perform the trimmed Spearman-Karber method. The list "expected" contains the results of that DOS program run on the data from Hamilton et al. Some of these are NA because the EPA program didn't return a result. The EPA program uses a confidence of 2*pnorm(2)-1=0.9544997 (that is, exactly two sigmas on both sides). - -```{r} -## install.packages("isotone") -## devtools::install_github(repo="brsr/tsk") - -library(drcHelper) -## library(tsk) -tsk(c(1, 10, 100, 1000), 20, c(0, 3, 17, 20)) - -data(hamilton) - - -``` ## References diff --git a/vignettes/articles/Verification-of-Williams-Test.Rmd b/vignettes/articles/Verification-of-Williams-Test.Rmd index 2a3a4fd..aa4bff1 100644 --- a/vignettes/articles/Verification-of-Williams-Test.Rmd +++ b/vignettes/articles/Verification-of-Williams-Test.Rmd @@ -75,5 +75,5 @@ print(bw_inc) ## Notes -- If you try alternative = "two.sided" with PMCMRplus, it may work (depending on PMCMRplus::williamsTest implementation) but Williams is commonly used as a one-sided trend test. If you need two-sided, please run it and share the output so I can advise on how to interpret the result in your validation framework. +- If you try alternative = "two.sided" with PMCMRplus, it may work (depending on PMCMRplus::williamsTest implementation) but Williams is commonly used as a one-sided trend test. - Always ensure the control group is the first factor level; Williams comparisons and Tcrit depend on the factor ordering. From 45fa5e37b02bb86c97c7ca6084f33a37c79216ee Mon Sep 17 00:00:00 2001 From: Zhenglei Gao Date: Tue, 30 Sep 2025 18:49:10 +0200 Subject: [PATCH 8/9] fixing broken links in .Rd --- NAMESPACE | 1 + R/RSCABS.R | 22 +++++++++++----------- R/drc_Helper.R | 2 +- man/SpearmanKarber_modified.Rd | 2 +- man/analyze_SK.Rd | 2 +- man/compute_mdd_williams.Rd | 21 +++++++++++++++++++++ 6 files changed, 36 insertions(+), 14 deletions(-) create mode 100644 man/compute_mdd_williams.Rd diff --git a/NAMESPACE b/NAMESPACE index 308b16c..9ce011d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,6 +36,7 @@ export(calcTaronesTest) export(calculate_noec_rstatix) export(cochranArmitageTrendTest) export(compare_to_control_fisher) +export(compute_mdd_williams) export(contEndpoint) export(convert2Score) export(convert_fish_data) diff --git a/R/RSCABS.R b/R/RSCABS.R index e3011a5..f8c0f5a 100644 --- a/R/RSCABS.R +++ b/R/RSCABS.R @@ -7,19 +7,19 @@ #' Run RSCABS test (DEPRECATED) #' -#' @description -#' **DEPRECATED**: Please use [step_down_RSCABS()] instead for new code. -#' +#' @description +#' **DEPRECATED**: Please use [drcHelper::step_down_RSCABS()] instead for new code. +#' #' Runs the Rao-Scott adjusted Cochran-Armitage trend test by slices (RSCABS) #' analysis.The function is adapted from the archived version of RSCABS developed by #' Joe Swintek et al with CC0 license. It is not updated anymore and included -#' for validation purpose. The modern replacement is [step_down_RSCABS()]. -#' -#' @details +#' for validation purpose. The modern replacement is [drcHelper::step_down_RSCABS()]. +#' +#' @details #' This function is deprecated. For new analyses, please use the modern -#' implementation in [step_down_RSCABS()] which provides: +#' implementation in [drcHelper::step_down_RSCABS()] which provides: #' - Better error handling and input validation -#' - More flexible data input formats +#' - More flexible data input formats #' - Improved statistical methodology #' - Better documentation and examples #' @@ -51,11 +51,11 @@ #' } runRSCABS <- function(Data,Treatment,Replicate='',Effects='',test.type='RS'){ # Issue deprecation warning - .Deprecated("step_down_RSCABS", - msg = paste("runRSCABS() is deprecated.", + .Deprecated("step_down_RSCABS", + msg = paste("runRSCABS() is deprecated.", "Please use step_down_RSCABS() for new code.", "See ?step_down_RSCABS for the modern API.")) - + #This function will produce a table of step-down Cochran-Armitage trend tests with possible Rao-Scott adjustment by slices #It will Run the test on every effect in the Effect list #' @export diff --git a/R/drc_Helper.R b/R/drc_Helper.R index e1a7dcf..85e2fa3 100644 --- a/R/drc_Helper.R +++ b/R/drc_Helper.R @@ -302,7 +302,7 @@ getModelName <- function(fname = NULL) { #' @rdname ED.plus #' @details #' Due to old ECxHelper development where ED.plus is defined as ED.ZG -#' @seealso [ED.plus()] for the public version of usage +#' @seealso [drcHelper::ED.plus()] for the public version of usage #' @export ED.ZG #' @keywords Deprecated ED.ZG <- function(...) { diff --git a/man/SpearmanKarber_modified.Rd b/man/SpearmanKarber_modified.Rd index 2f41494..4c7f168 100644 --- a/man/SpearmanKarber_modified.Rd +++ b/man/SpearmanKarber_modified.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tests_wrapper.R +% Please edit documentation in R/SK_TSK_tests_wrapper.R \name{SpearmanKarber_modified} \alias{SpearmanKarber_modified} \title{Spearman-Karber Estimation with Modified Handling for Control Mortality} diff --git a/man/analyze_SK.Rd b/man/analyze_SK.Rd index 17b63fd..4841a28 100644 --- a/man/analyze_SK.Rd +++ b/man/analyze_SK.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/tests_wrapper.R +% Please edit documentation in R/SK_TSK_tests_wrapper.R \name{analyze_SK} \alias{analyze_SK} \title{Unified Spearman-Karber Analysis Function} diff --git a/man/compute_mdd_williams.Rd b/man/compute_mdd_williams.Rd new file mode 100644 index 0000000..7c95561 --- /dev/null +++ b/man/compute_mdd_williams.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/MDD.R +\name{compute_mdd_williams} +\alias{compute_mdd_williams} +\title{Calculate MDD\% for a Williams Test Result} +\usage{ +compute_mdd_williams(williams_obj, data, formula) +} +\arguments{ +\item{williams_obj}{The tibble result from broom_williams.} + +\item{data}{The original dataframe used for the test.} + +\item{formula}{The formula used for the test, e.g., Response ~ Dose.} +} +\value{ +A tibble with Dose, MDD, and MDD_pct. +} +\description{ +Calculate MDD\% for a Williams Test Result +} From 53249fb1200a0c2b3eb2909e2543f63e3db1effa Mon Sep 17 00:00:00 2001 From: Zhenglei Gao Date: Tue, 30 Sep 2025 19:28:44 +0200 Subject: [PATCH 9/9] updated pkgdown.yml to include MDD article --- REDUNDANCY_ANALYSIS.md | 18 +++++++++--------- _pkgdown.yml | 3 +++ 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/REDUNDANCY_ANALYSIS.md b/REDUNDANCY_ANALYSIS.md index beb003d..8075b5b 100644 --- a/REDUNDANCY_ANALYSIS.md +++ b/REDUNDANCY_ANALYSIS.md @@ -14,7 +14,7 @@ This document identifies structural redundancy issues in the drcHelper package a - `stepDownRSCABS()` - Internal step-down procedure - `stepKRSCABS()` - Internal helper - Documented as "for validation purpose" - - Uses older API design + - Uses older implementation design - **Current Implementation** (`R/RSCABS_AO.R`, 934 lines): - `step_down_RSCABS()` - Modern step-down procedure @@ -24,13 +24,13 @@ This document identifies structural redundancy issues in the drcHelper package a - By Allen Olmstead, more modern design **Impact**: -- API confusion with similar function names +- implementation confusion with similar function names - Maintenance burden of two codebases - Test suite covers both implementations **Recommendation**: - Phase out legacy implementation gradually -- Update tests to use modern API +- Update tests to use modern implementation - Add deprecation warnings to legacy functions ### 2. Large Monolithic Files (MEDIUM PRIORITY) @@ -61,7 +61,7 @@ This document identifies structural redundancy issues in the drcHelper package a - Cochran-Armitage: `stepdown_binom.R`, `RSCABS_AO.R` (different purposes) **Note**: Some apparent "duplication" serves different purposes: -- `cochranArmitageTrendTest()` - General-purpose public API +- `cochranArmitageTrendTest()` - General-purpose public implementation - `get_CA_Z()` - Internal utility for clustered data - These are NOT redundant @@ -70,9 +70,9 @@ This document identifies structural redundancy issues in the drcHelper package a ### Phase 1: Documentation and Planning - [x] Create this analysis document - [ ] Add deprecation warnings to legacy functions -- [ ] Document migration path from old to new API +- [ ] Document migration path from old to new implementation -### Phase 2: API Consolidation +### Phase 2: implementation Consolidation - [ ] Update tests to prefer modern RSCA implementation - [ ] Add wrapper functions for backward compatibility - [ ] Mark legacy functions as deprecated in documentation @@ -92,13 +92,13 @@ This document identifies structural redundancy issues in the drcHelper package a ### Completed in This Analysis - [x] **Removed empty placeholder file** (`R/MQJT.R`) - [x] **Added deprecation warnings** to `runRSCABS()` -- [x] **Updated documentation** to clearly distinguish legacy vs modern APIs +- [x] **Updated documentation** to clearly distinguish legacy vs modern implementations - [x] **Created comprehensive analysis** of all redundancy issues ### Deferred for Future Work - [ ] **Breaking up large files**: Requires careful dependency analysis - [ ] **Removing deprecated functions**: Should wait for major version bump -- [ ] **API consolidation**: Needs broader team discussion on backward compatibility +- [ ] **implementation consolidation**: Needs broader team discussion on backward compatibility ## Impact Assessment @@ -119,4 +119,4 @@ This document identifies structural redundancy issues in the drcHelper package a - **User Impact**: Existing code works unchanged, users get helpful deprecation guidance ## Backward Compatibility -All changes maintain full backward compatibility. Legacy functions remain available and functional but issue deprecation warnings to guide users toward modern implementations. No existing code needs to be changed immediately. \ No newline at end of file +All changes maintain full backward compatibility. Legacy functions remain available and functional but issue deprecation warnings to guide users toward modern implementations. No existing code needs to be changed immediately. diff --git a/_pkgdown.yml b/_pkgdown.yml index 6dbdee8..d999a71 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -76,6 +76,8 @@ navbar: href: articles/Trend-Testing.html - text: NOEC ECx and BMD href: articles/NOEC_ECx_BMD.html + - text: MDD in Regulatory Context + href: articles/MDD-in-Regulatory-Context.html articles: text: Articles menu: @@ -186,6 +188,7 @@ articles: - articles/NOEC_ECx_BMD - articles/OECD_ED_Assays - articles/Test-Guidelines + - articles/MDD-in-Regulatory-Context - title: "Validation" desc: >