From ce1d04d07323961582e450324a0f3fc1a16b5048 Mon Sep 17 00:00:00 2001 From: "ccbr-bot[bot]" <258092125+ccbr-bot[bot]@users.noreply.github.com> Date: Mon, 27 Jul 2026 15:18:18 +0000 Subject: [PATCH] chore(syncweaver): update tracked sources from CCBR/MOSuite@v0.4.0 --- .syncweaver-lock.json | 4 +- code/MOSuite/.Rbuildignore | 29 +- .../.github/workflows/R-CMD-check.yaml | 7 +- .../MOSuite/.github/workflows/auto-format.yml | 3 +- .../workflows/syncweaver-source-dispatch.yml | 92 +++ code/MOSuite/.gitignore | 29 +- code/MOSuite/.lintr | 1 + code/MOSuite/.pre-commit-config.yaml | 7 +- code/MOSuite/.vscode/extensions.json | 5 - code/MOSuite/.vscode/settings.json | 13 - code/MOSuite/AGENTS.md | 58 ++ code/MOSuite/CITATION.cff | 49 +- code/MOSuite/DESCRIPTION | 9 +- code/MOSuite/NAMESPACE | 6 + code/MOSuite/NEWS.md | 17 +- code/MOSuite/R/batch-correction.R | 124 +++- code/MOSuite/R/clean.R | 60 +- code/MOSuite/R/colors.R | 323 +++++++-- code/MOSuite/R/counts.R | 70 ++ code/MOSuite/R/data.R | 14 + code/MOSuite/R/differential.R | 4 +- code/MOSuite/R/filter.R | 243 +++++-- code/MOSuite/R/normalize.R | 63 +- code/MOSuite/R/plot_heatmap.R | 377 +++++------ code/MOSuite/R/plot_histogram.R | 264 ++++++-- code/MOSuite/R/plot_pca.R | 310 +++++---- code/MOSuite/R/plot_read_depth.R | 79 ++- code/MOSuite/R/plot_volcano_summary.R | 2 +- code/MOSuite/R/plots.R | 182 +++++ code/MOSuite/R/reexports.R | 5 + code/MOSuite/R/render_report.R | 64 ++ code/MOSuite/SECURITY.md | 18 + code/MOSuite/_pkgdown.yml | 4 +- code/MOSuite/codemeta.json | 2 +- code/MOSuite/data-raw/mosuite_palette.R | 26 + code/MOSuite/data/mosuite_palette.rda | Bin 0 -> 174 bytes .../1_mosuite-templates/filter_counts.json | 4 +- .../1_mosuite-templates/normalize_counts.json | 4 +- .../2_blueprints/batch_correct_counts.json | 5 +- .../galaxy/2_blueprints/filter_counts.json | 24 +- .../galaxy/2_blueprints/normalize_counts.json | 14 +- .../2_blueprints/plot_expr_heatmap.json | 4 +- .../galaxy/2_blueprints/plot_pca_2d.json | 17 +- .../galaxy/2_blueprints/plot_pca_3d.json | 3 +- .../common/batch_correct_counts.json | 1 + .../json_args/common/filter_counts.json | 8 +- .../json_args/common/normalize_counts.json | 21 +- .../extdata/json_args/common/plot_pca_2d.json | 3 +- .../defaults/batch_correct_counts.json | 20 +- .../json_args/defaults/clean_raw_counts.json | 2 + .../json_args/defaults/filter_counts.json | 8 +- .../json_args/defaults/normalize_counts.json | 6 +- .../json_args/defaults/plot_expr_heatmap.json | 3 +- .../json_args/defaults/plot_pca_2d.json | 9 +- .../json_args/defaults/plot_pca_3d.json | 5 +- code/MOSuite/inst/quarto/report.qmd | 165 +++++ code/MOSuite/man/batch_correct_counts.Rd | 87 ++- code/MOSuite/man/clean_raw_counts.Rd | 10 + code/MOSuite/man/diff_counts.Rd | 2 +- code/MOSuite/man/display_colors.Rd | 24 + code/MOSuite/man/display_palette.Rd | 24 + code/MOSuite/man/filter_counts.Rd | 45 +- code/MOSuite/man/get_colors_lst.Rd | 15 +- code/MOSuite/man/get_colors_vctr.Rd | 22 +- code/MOSuite/man/get_observed_values.Rd | 22 + code/MOSuite/man/get_random_colors.Rd | 5 +- code/MOSuite/man/log_transform_counts.Rd | 35 + code/MOSuite/man/mosuite_palette.Rd | 25 + code/MOSuite/man/normalize_counts.Rd | 32 +- .../man/plot_corr_heatmap-data.frame.Rd | 4 +- .../man/plot_corr_heatmap-multiOmicDataSet.Rd | 9 + code/MOSuite/man/plot_corr_heatmap.Rd | 5 +- code/MOSuite/man/plot_expr_heatmap.Rd | 33 +- code/MOSuite/man/plot_histogram.data.frame.Rd | 13 +- .../man/plot_histogram.multiOmicDataSet.Rd | 9 + code/MOSuite/man/plot_palette.Rd | 21 + code/MOSuite/man/plot_pca.Rd | 6 + code/MOSuite/man/plot_pca_2d.Rd | 88 ++- code/MOSuite/man/plot_pca_3d.Rd | 44 +- .../MOSuite/man/plot_read_depth.data.frame.Rd | 10 + .../man/plot_read_depth.multiOmicDataSet.Rd | 9 + code/MOSuite/man/reexports.Rd | 3 +- code/MOSuite/man/remove_low_count_genes.Rd | 16 +- code/MOSuite/man/render_report.Rd | 54 ++ code/MOSuite/man/resolve_plot_colors.Rd | 33 + code/MOSuite/man/select_mosuite_colors.Rd | 22 + code/MOSuite/man/set_color_pal.Rd | 12 +- code/MOSuite/tests/testthat/_snaps/E2E.md | 2 - .../testthat/_snaps/plot_volcano_summary.md | 11 + .../tests/testthat/_snaps/plots/heatmap.png | Bin 0 -> 23016 bytes .../testthat/_snaps/plots/read_depth.png | Bin 0 -> 143716 bytes .../MOSuite/tests/testthat/helper-functions.R | 54 ++ .../tests/testthat/test-batch-correction.R | 389 ++++++++++- code/MOSuite/tests/testthat/test-clean.R | 187 +++++ code/MOSuite/tests/testthat/test-colors.R | 368 +++++++--- code/MOSuite/tests/testthat/test-filter.R | 639 ++++++++++++++++++ code/MOSuite/tests/testthat/test-normalize.R | 343 ++++++++++ .../tests/testthat/test-plot_heatmap.R | 321 +++++++++ .../tests/testthat/test-plot_histogram.R | 296 ++++++++ code/MOSuite/tests/testthat/test-plot_pca.R | 451 +++++++++++- .../tests/testthat/test-plot_read_depth.R | 60 ++ .../testthat/test-plot_volcano_enhanced.R | 33 +- code/MOSuite/tests/testthat/test-plots.R | 15 +- .../tests/testthat/test-render_report.R | 37 + code/MOSuite/vignettes/visualization.Rmd | 150 +++- 105 files changed, 6020 insertions(+), 964 deletions(-) create mode 100644 code/MOSuite/.github/workflows/syncweaver-source-dispatch.yml delete mode 100644 code/MOSuite/.vscode/extensions.json delete mode 100644 code/MOSuite/.vscode/settings.json create mode 100644 code/MOSuite/AGENTS.md create mode 100644 code/MOSuite/R/render_report.R create mode 100644 code/MOSuite/SECURITY.md create mode 100644 code/MOSuite/data-raw/mosuite_palette.R create mode 100644 code/MOSuite/data/mosuite_palette.rda create mode 100644 code/MOSuite/inst/quarto/report.qmd create mode 100644 code/MOSuite/man/display_colors.Rd create mode 100644 code/MOSuite/man/display_palette.Rd create mode 100644 code/MOSuite/man/get_observed_values.Rd create mode 100644 code/MOSuite/man/log_transform_counts.Rd create mode 100644 code/MOSuite/man/mosuite_palette.Rd create mode 100644 code/MOSuite/man/plot_palette.Rd create mode 100644 code/MOSuite/man/render_report.Rd create mode 100644 code/MOSuite/man/resolve_plot_colors.Rd create mode 100644 code/MOSuite/man/select_mosuite_colors.Rd create mode 100644 code/MOSuite/tests/testthat/_snaps/plots/heatmap.png create mode 100644 code/MOSuite/tests/testthat/_snaps/plots/read_depth.png create mode 100644 code/MOSuite/tests/testthat/test-render_report.R diff --git a/.syncweaver-lock.json b/.syncweaver-lock.json index 7c6734d..5ca4544 100644 --- a/.syncweaver-lock.json +++ b/.syncweaver-lock.json @@ -5,8 +5,8 @@ "sources": { "code/MOSuite": { "repo_url": "https://github.com/CCBR/MOSuite", - "ref": "v0.3.2", - "git_sha": "f4465c58a7d04f5feb41d4455a019ca4946a4ca8" + "ref": "v0.4.0", + "git_sha": "ef1bdf806d153515e8ecbb8a8d2bfc518a418e05" } } } diff --git a/code/MOSuite/.Rbuildignore b/code/MOSuite/.Rbuildignore index 7ee19e0..3dbf9be 100644 --- a/code/MOSuite/.Rbuildignore +++ b/code/MOSuite/.Rbuildignore @@ -1,37 +1,38 @@ -^renv$ -^renv\.lock$ ^_pkgdown\.yml$ +^[.]?air[.]toml$ ^\.github$ ^\.lintr$ +^\.posit$ ^\.pre-commit-config\.yaml$ ^\.prettierignore$ ^\.prettierrc$ ^\.Rproj\.user$ +^\.vscode$ ^CITATION\.cff$ ^codemeta\.json$ ^data-raw$ ^doc$ -^Dockerfile$ ^docker$ +^Dockerfile$ ^docs$ ^figures$ +^inst/quarto/report_files$ ^LICENSE\.md$ ^Meta$ +^moo_input\.rds$ ^MOSuite\.Rproj$ ^pkgdown$ -^README\.Rmd$ -^README\.html$ -^README_files$ -^Rplots\.pdf$ -^moo_input\.rds$ ^plot-volc-enh\.json$ -^volc-sum-params\.json$ -^report_files$ -^inst/quarto/report_files$ +^README.*$ +^renv\.lock$ +^renv$ +^report +^Rplots\.pdf$ +^SECURITY\.md$ ^tests/figures$ +^vignettes/cli\.Rmd$ ^vignettes/figures/$ ^vignettes/memory\.Rmd$ -^vignettes/cli\.Rmd$ +^volc-sum-params\.json$ VennDiagram.*\.log -^[.]?air[.]toml$ -^\.vscode$ +^\.posit/assistant$ diff --git a/code/MOSuite/.github/workflows/R-CMD-check.yaml b/code/MOSuite/.github/workflows/R-CMD-check.yaml index e4a69e6..d2449c3 100644 --- a/code/MOSuite/.github/workflows/R-CMD-check.yaml +++ b/code/MOSuite/.github/workflows/R-CMD-check.yaml @@ -6,7 +6,6 @@ on: push: branches: [main, master] pull_request: - branches: [main, master] workflow_dispatch: concurrency: @@ -23,8 +22,8 @@ jobs: fail-fast: false matrix: config: - - { os: ubuntu-latest, r: 'release' } - - { os: ubuntu-latest, r: 'oldrel-1' } + - { os: ubuntu-latest, r: "release" } + - { os: ubuntu-latest, r: "oldrel-1" } runs-on: ${{ matrix.config.os }} name: ${{ matrix.config.os }} (${{ matrix.config.r }}) env: @@ -51,7 +50,7 @@ jobs: - uses: actions/checkout@v6 - uses: r-lib/actions/setup-r@v2 with: - r-version: '4.5' + r-version: "4.5" use-public-rspm: true - uses: r-lib/actions/setup-r-dependencies@v2 with: diff --git a/code/MOSuite/.github/workflows/auto-format.yml b/code/MOSuite/.github/workflows/auto-format.yml index 758c5ba..b8a2ae7 100644 --- a/code/MOSuite/.github/workflows/auto-format.yml +++ b/code/MOSuite/.github/workflows/auto-format.yml @@ -3,7 +3,6 @@ name: auto-format on: workflow_dispatch: pull_request: - branches: [ main, master ] permissions: contents: write @@ -40,7 +39,7 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: - r-version: '4.5' + r-version: "4.5" use-public-rspm: true - uses: r-lib/actions/setup-r-dependencies@v2 diff --git a/code/MOSuite/.github/workflows/syncweaver-source-dispatch.yml b/code/MOSuite/.github/workflows/syncweaver-source-dispatch.yml new file mode 100644 index 0000000..74a4450 --- /dev/null +++ b/code/MOSuite/.github/workflows/syncweaver-source-dispatch.yml @@ -0,0 +1,92 @@ +name: syncweaver-source-dispatch + +on: + release: + types: [published] + workflow_dispatch: + inputs: + source_ref: + description: Optional source ref to dispatch (defaults to release tag for release events, or current ref for manual runs). + required: false + type: string + source_repo: + description: Optional source repository override in OWNER/REPO format (defaults to current repository). + required: false + type: string + orchestrator-repo: + description: Optional orchestrator repository override in OWNER/REPO format. + required: false + default: NIDAP-Community/syncweaver-orchestrator + type: string + +permissions: + contents: read + +jobs: + notify-syncweaver: + runs-on: ubuntu-latest + env: + SOURCE_REPOSITORY: ${{ github.event_name == 'workflow_dispatch' && github.event.inputs.source_repo || github.repository }} + SOURCE_REF: ${{ github.event_name == 'release' && github.event.release.tag_name || github.event.inputs.source_ref || github.ref_name }} + ORCHESTRATOR_REPO: ${{ github.event_name == 'workflow_dispatch' && github.event.inputs['orchestrator-repo'] || vars['orchestrator-repo'] || 'NIDAP-Community/syncweaver-orchestrator' }} + steps: + - name: Validate dispatch payload + shell: bash + run: | + set -euo pipefail + if [[ -z "${SOURCE_REPOSITORY//[[:space:]]/}" ]]; then + echo "Error: source repository cannot be empty." >&2 + exit 1 + fi + if [[ -z "${SOURCE_REF//[[:space:]]/}" ]]; then + echo "Error: source ref cannot be empty." >&2 + exit 1 + fi + if [[ -z "${ORCHESTRATOR_REPO//[[:space:]]/}" ]]; then + echo "Error: orchestrator repository cannot be empty." >&2 + exit 1 + fi + if [[ "${ORCHESTRATOR_REPO}" != */* ]]; then + echo "Error: orchestrator repository must be in OWNER/REPO format." >&2 + exit 1 + fi + if [[ -z "${{ vars.CCBR_BOT_APP_ID }}" ]]; then + echo "Error: vars.CCBR_BOT_APP_ID is required to generate a dispatch token." >&2 + exit 1 + fi + if [[ -z "${{ secrets.CCBR_BOT_PRIVATE_KEY }}" ]]; then + echo "Error: secrets.CCBR_BOT_PRIVATE_KEY is required to generate a dispatch token." >&2 + exit 1 + fi + + - name: Resolve orchestrator repository owner and name + id: orchestrator_repo + shell: bash + run: | + set -euo pipefail + owner="${ORCHESTRATOR_REPO%%/*}" + repo="${ORCHESTRATOR_REPO#*/}" + if [[ -z "${owner}" || -z "${repo}" ]]; then + echo "Error: failed to parse orchestrator repository '${ORCHESTRATOR_REPO}'." >&2 + exit 1 + fi + echo "owner=${owner}" >> "$GITHUB_OUTPUT" + echo "repository=${repo}" >> "$GITHUB_OUTPUT" + + - name: Generate CCBR-bot token + id: ccbr_bot + uses: actions/create-github-app-token@v3 + with: + client-id: ${{ vars.CCBR_BOT_APP_ID }} + private-key: ${{ secrets.CCBR_BOT_PRIVATE_KEY }} + owner: ${{ steps.orchestrator_repo.outputs.owner }} + repositories: ${{ steps.orchestrator_repo.outputs.repository }} + + - name: Dispatch syncweaver-update-hosts workflow in orchestrator repo + uses: peter-evans/repository-dispatch@v4 + with: + token: ${{ steps.ccbr_bot.outputs.token }} + repository: ${{ env.ORCHESTRATOR_REPO }} + event-type: syncweaver-update-hosts + client-payload: >- + {"source_repository": ${{ toJson(env.SOURCE_REPOSITORY) }}, "ref": ${{ toJson(env.SOURCE_REF) }}} diff --git a/code/MOSuite/.gitignore b/code/MOSuite/.gitignore index a7f1be5..4d2ccac 100644 --- a/code/MOSuite/.gitignore +++ b/code/MOSuite/.gitignore @@ -1,21 +1,24 @@ -.Rproj.user -.Rhistory -.Rdata -.httr-oauth .DS_Store -.quarto -docs -inst/doc +*_files/ +**/figures/ +/.github/plans/ +/.httr-oauth +/.posit/ +/.quarto +/.Rdata +/.Rhistory +/.Rproj.user +/.vscode/ /doc/ +/docs +/inst/doc /Meta/ /README.html -**/figures/ -VennDiagram.*.log -*_files/ -tests/testthat/Rplots.pdf +/tests/testthat/Rplots.pdf /tmp -vignettes/args*.json -Rplots.pdf +/vignettes/args*.json moo_input.rds plot-volc-enh.json +Rplots.pdf +VennDiagram.*.log volc-sum-params.json diff --git a/code/MOSuite/.lintr b/code/MOSuite/.lintr index e636784..4250828 100644 --- a/code/MOSuite/.lintr +++ b/code/MOSuite/.lintr @@ -3,6 +3,7 @@ linters: linters_with_defaults( commented_code_linter = NULL, object_name_linter = NULL, object_length_linter = object_length_linter(60L), + object_usage_linter = NULL, return_linter = return_linter( return_style = "explicit" ), diff --git a/code/MOSuite/.pre-commit-config.yaml b/code/MOSuite/.pre-commit-config.yaml index a09d9f3..0cfa3db 100644 --- a/code/MOSuite/.pre-commit-config.yaml +++ b/code/MOSuite/.pre-commit-config.yaml @@ -20,20 +20,19 @@ repos: - id: trailing-whitespace # spell check - repo: https://github.com/codespell-project/codespell - rev: v2.4.2 + rev: v2.4.3 hooks: - id: codespell args: ["-I=.github/WORDLIST.txt"] # R formatting - repo: https://github.com/posit-dev/air-pre-commit - rev: 0.9.0 + rev: 0.10.0 hooks: - id: air-format - repo: https://github.com/lorenzwalthert/precommit - rev: v0.4.3.9025 + rev: v0.4.3.9029 hooks: - id: parsable-R - - id: readme-rmd-rendered - id: use-tidy-description - id: lintr args: [--warn_only] diff --git a/code/MOSuite/.vscode/extensions.json b/code/MOSuite/.vscode/extensions.json deleted file mode 100644 index 344f76e..0000000 --- a/code/MOSuite/.vscode/extensions.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "recommendations": [ - "Posit.air-vscode" - ] -} diff --git a/code/MOSuite/.vscode/settings.json b/code/MOSuite/.vscode/settings.json deleted file mode 100644 index 61ac215..0000000 --- a/code/MOSuite/.vscode/settings.json +++ /dev/null @@ -1,13 +0,0 @@ -{ - "[r]": { - "editor.formatOnSave": true, - "editor.defaultFormatter": "Posit.air-vscode" - }, - "[quarto]": { - "editor.formatOnSave": true, - "editor.defaultFormatter": "quarto.quarto" - }, - "chat.tools.terminal.autoApprove": { - "timeout": true - } -} diff --git a/code/MOSuite/AGENTS.md b/code/MOSuite/AGENTS.md new file mode 100644 index 0000000..a66f421 --- /dev/null +++ b/code/MOSuite/AGENTS.md @@ -0,0 +1,58 @@ +# multiOmicsSuite + +## Description + +multiOmicsSuite (`MOSuite`) is an R package for differential multi-omic analysis. +It defines an S7 class called `multiOmicDataSet` to store data and analyses from +multi-omic experiments. + +Development of MOSuite follows the R packages 2nd edition (https://r-pkgs.org/), +with a few minor exceptions noted below. +Helper functions from `usethis` and `devtools` are used extensively for development tasks. + +## Package conventions + +- **Internal functions should have roxygen2 documentation** (with `@keywords internal`). Do not strip roxygen docs from internal functions. +- R code should pass `lintr` and `air format` (run `air format .` from the package root). +- Tests should be written with `testthat`. +- The package must pass `devtools::check()`. +- R code should adhere to the tidyverse style guide. https://style.tidyverse.org/ +- Only include one return statement at the end of a function, if a return statement is used at all. Explicit returns are preferred but not required for R functions. + +## Commit messages + +- Commit messages must follow [Conventional Commits](https://www.conventionalcommits.org/en/v1.0.0/) (as enforced in `CONTRIBUTING.md`). +- Generate messages from staged changes only (`git diff --staged`); do not include unrelated work. +- Commits should be atomic: one logical change per commit. +- If mixed changes are present, split into multiple logical commits; the number of commits does not need to equal the number of files changed. +- Subject format must be: `(optional-scope): short imperative summary` (<=72 chars), e.g., `fix(profile): update release table parser`. +- Add a body only when needed to explain **why** and notable impact; never include secrets, tokens, PHI, or large diffs. +- For AI-assisted commits, add this final italicized footer line in the commit message body: _commit message is ai-generated_ + +## Pull request (PR) process + +- When opening a PR, use the request template (`.github/PULL_REQUEST_TEMPLATE.md`) and fill out all sections of the template in the PR description. +- Do not allow the developer to proceed with opening a PR if it does not fill out all sections of the template. +- Before a PR can be moved from draft to "ready for review", all of the relevant checklist items must be checked, and any +irrelevant checklist items should be crossed out. +- If code is AI-generated, the PR should be labeled `generated-by-AI`. There should be a brief, concise statement in the PR description of how AI was used in creating the PR (model used, high-level prompt intent, manual review confirmation). +- When new features, bug fixes, or other behavioral changes are introduced to the code, +unit tests must be added or updated to cover the new or changed functionality. +- If there are any API or other user-facing changes, the documentation must be updated both inline via roxygen comments and long-form docs in the `vignettes/` directory as R Markdown files. +- The `R-CMD-check` github actions workflow must pass before the PR can be approved. + +### Changelog + +The changelog for the repository is maintained in `NEWS.md` at the root of the repository. +Each pull request that introduces user-facing changes must include a concise +entry with the PR number and author username tagged. +Developer-only changes (i.e. updates to CI workflows, development notes, etc.) +should never be included in the changelog. + +Example: + +``` +## development version + +- Fix bug in `detect_absolute_paths()` to ignore comments. (#123, @username) +``` diff --git a/code/MOSuite/CITATION.cff b/code/MOSuite/CITATION.cff index 9768535..f090eb6 100644 --- a/code/MOSuite/CITATION.cff +++ b/code/MOSuite/CITATION.cff @@ -8,7 +8,7 @@ message: 'To cite package "MOSuite" in publications use:' type: software license: MIT title: 'MOSuite: R package for differential multi-omics analysis' -version: 0.3.2 +version: 0.4.0 doi: 10.5281/zenodo.16371580 identifiers: - description: Archived snapshots of all versions @@ -78,7 +78,7 @@ references: address: Vienna, Austria year: '2026' doi: 10.32614/R.manuals - version: '>= 4.0.0' + version: '>= 4.1.0' - type: software title: assertthat abstract: 'assertthat: Easy Pre and Post Assertions' @@ -234,6 +234,19 @@ references: orcid: https://orcid.org/0000-0002-6983-2759 year: '2026' doi: 10.32614/CRAN.package.glue +- type: software + title: grid + abstract: 'R: A Language and Environment for Statistical Computing' + notes: Imports + authors: + - name: R Core Team + website: https://ror.org/02zz1nj61 + institution: + name: R Foundation for Statistical Computing + website: https://ror.org/05qewa988 + address: Vienna, Austria + year: '2026' + doi: 10.32614/R.manuals - type: software title: htmlwidgets abstract: 'htmlwidgets: HTML Widgets for R' @@ -354,6 +367,19 @@ references: email: pedro@plot.ly year: '2026' doi: 10.32614/CRAN.package.plotly +- type: software + title: png + abstract: 'png: Read and write PNG images' + notes: Imports + url: https://www.rforge.net/png/ + repository: https://CRAN.R-project.org/package=png + authors: + - family-names: Urbanek + given-names: Simon + email: Simon.Urbanek@r-project.org + orcid: https://orcid.org/0000-0003-2297-1732 + year: '2026' + doi: 10.32614/CRAN.package.png - type: software title: purrr abstract: 'purrr: Functional Programming Tools' @@ -679,7 +705,7 @@ references: authors: - family-names: Auguie given-names: Baptiste - email: baptiste.auguie@gmail.com + email: baptiste.auguie@vuw.ac.nz year: '2026' doi: 10.32614/CRAN.package.gridExtra - type: software @@ -731,6 +757,23 @@ references: given-names: Jim year: '2026' doi: 10.32614/CRAN.package.plotrix +- type: software + title: quarto + abstract: 'quarto: R Interface to ''Quarto'' Markdown Publishing System' + notes: Suggests + url: https://quarto-dev.github.io/quarto-r/ + repository: https://CRAN.R-project.org/package=quarto + authors: + - family-names: Allaire + given-names: JJ + email: jj@posit.co + orcid: https://orcid.org/0000-0003-0174-9868 + - family-names: Dervieux + given-names: Christophe + email: cderv@posit.co + orcid: https://orcid.org/0000-0003-4474-2498 + year: '2026' + doi: 10.32614/CRAN.package.quarto - type: software title: RColorBrewer abstract: 'RColorBrewer: ColorBrewer Palettes' diff --git a/code/MOSuite/DESCRIPTION b/code/MOSuite/DESCRIPTION index 8f728ed..f1b0d21 100644 --- a/code/MOSuite/DESCRIPTION +++ b/code/MOSuite/DESCRIPTION @@ -1,6 +1,6 @@ Package: MOSuite Title: R package for differential multi-omics analysis -Version: 0.3.2 +Version: 0.4.0 Authors@R: c( person("Kelly", "Sovacool", , "kelly.sovacool@nih.gov", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3283-829X")), @@ -22,7 +22,7 @@ License: MIT + file LICENSE URL: https://github.com/CCBR/MOSuite, https://ccbr.github.io/MOSuite/ BugReports: https://github.com/CCBR/MOSuite/issues Depends: - R (>= 4.0.0) + R (>= 4.1.0) Imports: assertthat, dendextend, @@ -31,6 +31,7 @@ Imports: edgeR, ggplot2, glue, + grid, htmlwidgets, jsonlite, limma, @@ -38,6 +39,7 @@ Imports: methods, options, plotly, + png, purrr, reshape2, rlang, @@ -63,6 +65,7 @@ Suggests: lobstr, patchwork, plotrix, + quarto, RColorBrewer, Rd2md, readr, @@ -82,11 +85,11 @@ VignetteBuilder: biocViews: Config/Needs/dev: cffr, covr, here, lintr, pkgdown, rcmdcheck, xml2 +Config/roxygen2/version: 8.0.0 Config/testthat/edition: 3 Config/testthat/parallel: true Encoding: UTF-8 LazyData: true LazyDataCompression: xz Roxygen: list(markdown = TRUE) -Config/roxygen2/version: 8.0.0 RoxygenNote: 8.0.0 diff --git a/code/MOSuite/NAMESPACE b/code/MOSuite/NAMESPACE index dcdf57a..7a4ba1f 100644 --- a/code/MOSuite/NAMESPACE +++ b/code/MOSuite/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand export("!!") +export("%||%") export(":=") export(.data) export(batch_correct_counts) @@ -13,6 +14,8 @@ export(cli_from_json) export(create_multiOmicDataSet_from_dataframes) export(create_multiOmicDataSet_from_files) export(diff_counts) +export(display_colors) +export(display_palette) export(do_math) export(extract_counts) export(filter_counts) @@ -38,6 +41,8 @@ export(plot_volcano_enhanced) export(plot_volcano_summary) export(print_or_save_plot) export(read_multiOmicDataSet) +export(render_report) +export(select_mosuite_colors) export(set_color_pal) export(setup_capsule_environment) export(write_multiOmicDataSet) @@ -47,5 +52,6 @@ importFrom(DESeq2,DESeq) importFrom(dendextend,rotate) importFrom(matrixStats,rowVars) importFrom(rlang,"!!") +importFrom(rlang,"%||%") importFrom(rlang,":=") importFrom(rlang,.data) diff --git a/code/MOSuite/NEWS.md b/code/MOSuite/NEWS.md index a1c1f01..bb89a9f 100644 --- a/code/MOSuite/NEWS.md +++ b/code/MOSuite/NEWS.md @@ -1,4 +1,19 @@ -## 0.3.2 +## MOSuite 0.4.0 + +- Fix expression heatmap clustering to correctly use the selected gene and sample distance metrics and clustering methods. (#231, @phoman14) +- Update PCA label, point-size, and histogram behavior. (#230, @phoman14) +- Add optional count log-transform controls for PCA plots. (#234, @phoman14) +- Add a post-clean CPM histogram output in `clean_raw_counts()`. (#234, @phoman14) +- Improvements to plot colors: (#223, @phoman14) + - Align plot color defaults with the MOSuite Code Ocean capsule defaults while preserving fallback random colors when a requested palette is too short. + - Improve top and bottom legend wrapping and automatic legend text sizing for PCA and histogram plots with many or long labels. + - Add optional group coloring to `plot_read_depth()` and the `clean_raw_counts()` read-depth output while preserving the single-color default when no group is selected. +- New function `display_colors()` shows a multiOmicDataSet's chosen color palettes, and `get_colors_lst()` now takes a palette vector rather than function for simplicity. (#236, @kelly-sovacool) +- New report template & helper function: `render_report()`. (#120, @kelly-sovacool) +- Fix ggplot2 size deprecation warning in `plot_volcano_summary()`. (#228, @kelly-sovacool) +- docs: show how to set `output_dir` in `render_report()`. (#235, @kelly-sovacool) + +## MOSuite 0.3.2 - Support ggplot2 v4.0.0 for correlation heatmap plots in `filter_counts()`, `normalize_counts()`, and `batch_correct_counts()`. (#205, @copilot, @kelly-sovacool) diff --git a/code/MOSuite/R/batch-correction.R b/code/MOSuite/R/batch-correction.R index bcbf63e..d0aaac0 100644 --- a/code/MOSuite/R/batch-correction.R +++ b/code/MOSuite/R/batch-correction.R @@ -54,10 +54,28 @@ batch_correct_counts <- function( samples_to_include = NULL, covariates_colnames = "Group", batch_colname = "Batch", - label_colname = NULL, + label_colname = "Label", + samples_to_rename = c(""), + add_label_to_pca = TRUE, + principal_component_on_x_axis = 1, + principal_component_on_y_axis = 2, + legend_position_for_pca = "top", + label_offset_x_ = 2, + label_offset_y_ = 2, + label_font_size = 3, + point_size_for_pca = 5, + color_histogram_by_group = TRUE, + set_min_max_for_x_axis_for_histogram = FALSE, + minimum_for_x_axis_for_histogram = -1, + maximum_for_x_axis_for_histogram = 1, + legend_font_size_for_histogram = NULL, + legend_position_for_histogram = "top", + number_of_histogram_legend_columns = 6, + plot_corr_matrix_heatmap = TRUE, colors_for_plots = NULL, print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), + interactive_plots = FALSE, plots_subdir = "batch" ) { abort_packages_not_installed("sva") @@ -103,6 +121,7 @@ batch_correct_counts <- function( if (is.null(samples_to_include)) { samples_to_include <- sample_metadata |> dplyr::pull(sample_id_colname) } + pca_label_colname <- if (isTRUE(add_label_to_pca)) label_colname else NULL if (is.null(label_colname)) { label_colname <- sample_id_colname } @@ -147,8 +166,13 @@ batch_correct_counts <- function( } if (isTRUE(print_plots) || isTRUE(save_plots)) { - if (is.null(colors_for_plots)) { - colors_for_plots <- moo@analyses[["colors"]][[batch_colname]] + colors_for_plots <- colors_for_plots %||% + moo@analyses$colors[[batch_colname]] + + if (isTRUE(color_histogram_by_group)) { + colors_for_histogram <- colors_for_plots + } else { + colors_for_histogram <- moo@analyses$colors[[label_colname]] } pca_plot <- plot_pca( combat_edata, @@ -156,8 +180,19 @@ batch_correct_counts <- function( sample_id_colname = sample_id_colname, feature_id_colname = feature_id_colname, group_colname = batch_colname, - label_colname = label_colname, + label_colname = pca_label_colname, + samples_to_rename = samples_to_rename, color_values = colors_for_plots, + principal_components = c( + principal_component_on_x_axis, + principal_component_on_y_axis + ), + legend_position = legend_position_for_pca, + point_size = point_size_for_pca, + label_font_size = label_font_size, + label_offset_y_ = label_offset_y_, + label_offset_x_ = label_offset_x_, + log_transform = FALSE, print_plots = FALSE, save_plots = FALSE ) + @@ -170,39 +205,68 @@ batch_correct_counts <- function( feature_id_colname = feature_id_colname, group_colname = batch_colname, label_colname = label_colname, - color_values = colors_for_plots, - color_by_group = TRUE - ) + - ggplot2::labs(caption = "batch-corrected counts") - corHM_plot <- plot_corr_heatmap( - combat_edata, - sample_metadata = sample_metadata, - sample_id_colname = sample_id_colname, - feature_id_colname = feature_id_colname, - group_colname = batch_colname, - label_colname = label_colname, - color_values = colors_for_plots + color_values = colors_for_histogram, + color_by_group = color_histogram_by_group, + set_min_max_for_x_axis = set_min_max_for_x_axis_for_histogram, + minimum_for_x_axis = minimum_for_x_axis_for_histogram, + maximum_for_x_axis = maximum_for_x_axis_for_histogram, + x_axis_label = "Batch Corrected Counts", + legend_position = legend_position_for_histogram, + legend_font_size = legend_font_size_for_histogram, + number_of_legend_columns = number_of_histogram_legend_columns, + interactive_plots = interactive_plots ) + if (!isTRUE(interactive_plots)) { + hist_plot <- hist_plot + ggplot2::labs(caption = "batch-corrected counts") + } + if (isTRUE(plot_corr_matrix_heatmap)) { + corHM_plot <- plot_corr_heatmap( + combat_edata, + sample_metadata = sample_metadata, + sample_id_colname = sample_id_colname, + feature_id_colname = feature_id_colname, + group_colname = batch_colname, + label_colname = label_colname, + color_values = colors_for_plots + ) + print_or_save_plot( + corHM_plot, + filename = file.path(plots_subdir, "corr_heatmap.png"), + print_plots = print_plots, + save_plots = save_plots, + caption = "batch-corrected counts" + ) + } - print_or_save_plot( - pca_plot, - filename = file.path(plots_subdir, "pca.png"), - print_plots = print_plots, - save_plots = save_plots - ) + plot_ext <- "png" + if (isTRUE(interactive_plots)) { + pca_plot <- pca_plot |> plotly::ggplotly(tooltip = "text") + plot_ext <- "html" + } + if (identical(plot_ext, "png")) { + print_or_save_plot( + pca_plot, + filename = file.path(plots_subdir, glue::glue("pca.{plot_ext}")), + print_plots = print_plots, + save_plots = save_plots, + width = 7, + height = 7, + units = "in" + ) + } else { + print_or_save_plot( + pca_plot, + filename = file.path(plots_subdir, glue::glue("pca.{plot_ext}")), + print_plots = print_plots, + save_plots = save_plots + ) + } print_or_save_plot( hist_plot, - filename = file.path(plots_subdir, "histogram.png"), + filename = file.path(plots_subdir, glue::glue("histogram.{plot_ext}")), print_plots = print_plots, save_plots = save_plots ) - print_or_save_plot( - corHM_plot, - filename = file.path(plots_subdir, "corr_heatmap.png"), - print_plots = print_plots, - save_plots = save_plots, - caption = "batch-corrected counts" - ) } message(glue::glue( diff --git a/code/MOSuite/R/clean.R b/code/MOSuite/R/clean.R index d14b2ca..0ee08c1 100644 --- a/code/MOSuite/R/clean.R +++ b/code/MOSuite/R/clean.R @@ -9,6 +9,12 @@ #' @inheritParams filter_counts #' @inheritParams option_params #' +#' @param group_colname sample metadata column used to color the read-depth plot. Leave blank to use the current +#' single-color bar fill. +#' @param colors_for_plots optional colors used when `group_colname` is supplied. If `NULL`, colors are taken from +#' `moo@analyses$colors[[group_colname]]`. +#' Named vectors are matched to group values; +#' unnamed vectors follow group order and are extended with MOSuite colors when too few colors are supplied. #' @param cleanup_column_names Invalid raw counts column names can cause errors #' in the downstream analysis. If this is `TRUE`, any invalid column names #' will be automatically altered to a correct format. These format changes @@ -55,6 +61,8 @@ clean_raw_counts <- function( sample_id_colname = NULL, feature_id_colname = NULL, samples_to_rename = "", + group_colname = "", + colors_for_plots = NULL, cleanup_column_names = TRUE, split_gene_name = TRUE, aggregate_rows_with_duplicate_gene_names = TRUE, @@ -74,7 +82,13 @@ clean_raw_counts <- function( } # Sample Read Counts Plot if (isTRUE(print_plots) || isTRUE(save_plots)) { - read_plot <- plot_read_depth(counts_dat) + read_plot <- plot_read_depth( + counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = sample_id_colname, + group_colname = group_colname, + color_values = colors_for_plots + ) print_or_save_plot( read_plot, filename = file.path(plots_subdir, "read_depth.png"), @@ -162,6 +176,50 @@ clean_raw_counts <- function( ) moo@counts[["clean"]] <- counts_dat + if (isTRUE(print_plots) || isTRUE(save_plots)) { + # CPM histogram after cleaning + # + # This QC plot is built from the cleaned count table after sample renaming, + # column cleanup, gene-name splitting, and duplicate aggregation. CPM is + # calculated first so library-size differences are accounted for, then genes + # with zero counts in every sample are removed from the plotted CPM table. + # When group_colname is supplied, the histogram is colored by that sample + # metadata group. The CPM calculation is plot-only here; it does not replace + # the raw or cleaned count slots used by downstream workflow steps. + cpm_feature_id_colname <- colnames(counts_dat)[1] + sample_colnames <- colnames(counts_dat)[ + vapply(counts_dat, is.numeric, logical(1)) + ] + color_cpm_histogram_by_group <- !is.null(group_colname) && + nzchar(trimws(group_colname)) + cpm_counts_dat <- calc_cpm_df( + counts_dat[, c(cpm_feature_id_colname, sample_colnames), drop = FALSE], + feature_id_colname = cpm_feature_id_colname + ) + cpm_counts_dat <- cpm_counts_dat[ + rowSums(cpm_counts_dat[, sample_colnames, drop = FALSE] != 0) > 0, + , + drop = FALSE + ] + cpm_hist_plot <- plot_histogram( + cpm_counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = sample_id_colname, + feature_id_colname = cpm_feature_id_colname, + group_colname = group_colname, + color_values = colors_for_plots, + color_by_group = color_cpm_histogram_by_group, + x_axis_label = "CPM", + use_log2_x_axis = TRUE + ) + + ggplot2::labs(caption = "CPM counts") + print_or_save_plot( + cpm_hist_plot, + filename = file.path(plots_subdir, "cpm_histogram.png"), + print_plots = print_plots, + save_plots = save_plots + ) + } return(moo) } diff --git a/code/MOSuite/R/colors.R b/code/MOSuite/R/colors.R index 291901f..97c6cd3 100644 --- a/code/MOSuite/R/colors.R +++ b/code/MOSuite/R/colors.R @@ -1,7 +1,10 @@ +utils::globalVariables("mosuite_palette") + #' Get random colors. #' -#' Note: this function is not guaranteed to create a color blind friendly palette. -#' Consider using other palettes such as `RColorBrewer::display.brewer.all(colorblindFriendly = TRUE)`. +#' Note: this function is not guaranteed to create a color blind friendly +#' palette. Consider using other palettes such as +#' `RColorBrewer::display.brewer.all(colorblindFriendly = TRUE)`. #' #' @param num_colors number of colors to select. #' @param n number of random RGB values to generate in the color space. @@ -32,90 +35,302 @@ get_random_colors <- function(num_colors, n = 2e3) { return(unname(colorspace::hex(colorspace::LAB(km$centers)))) } +#' Select colors from MOSuite's default palette +#' +#' @param n number of colors to select. +#' @param ... additional arguments (ignored). +#' +#' @returns vector of colors in hex format. +#' @export +#' +#' @examples +#' select_mosuite_colors(5) +select_mosuite_colors <- function(n, ...) { + return(mosuite_palette[seq_len(min(n, length(mosuite_palette)))]) +} + +#' Get observed values from a column +#' +#' Returns non-missing values from `dat[[colname]]`. For factor columns, values +#' are returned in factor-level order; otherwise, values keep first-observed +#' order. +#' +#' @param dat data frame +#' @param colname column name in `dat` +#' @returns character vector of observed values +#' @keywords internal +get_observed_values <- function(dat, colname) { + values <- dplyr::pull(dat, colname) + observed_values <- stats::na.omit(as.character(values)) + + if (is.factor(values)) { + return(levels(values)[levels(values) %in% observed_values]) + } + + return(unique(observed_values)) +} + #' Create named list of default colors for plotting #' #' @inheritParams create_multiOmicDataSet_from_dataframes #' -#' @param palette_fun Function for selecting colors. Assumed to contain `n` for the number of colors. Default: -#' `grDevices::palette.colors()` -#' @param ... additional arguments forwarded to `palette_fun` +#' @param palette Character vector of colors to assign. Defaults to +#' `mosuite_palette`. #' -#' @returns named list, with each column in `sample_metadata` containing entry with a named vector of colors +#' @returns named list, with each column in `sample_metadata` containing a corresponding entry with a named vector of +#' colors #' @export #' #' @examples #' get_colors_lst(nidap_sample_metadata) -#' \dontrun{ -#' get_colors_lst(nidap_sample_metadata, palette_fun = RColorBrewer::brewer.pal, name = "Set3") -#' } +#' get_colors_lst(nidap_sample_metadata, palette = RColorBrewer::brewer.pal(12, "Set3")) get_colors_lst <- function( sample_metadata, - palette_fun = grDevices::palette.colors, - ... + palette = mosuite_palette ) { dat_colnames <- colnames(sample_metadata) - color_lists <- dat_colnames |> - purrr::map( - .f = get_colors_vctr, + n_palette <- length(palette) + + color_offset <- 0L + color_lists <- vector("list", length(dat_colnames)) + for (i in seq_along(dat_colnames)) { + colname <- dat_colnames[[i]] + n_obs <- length(get_observed_values(sample_metadata, colname)) + # Only offset when the column is small enough that unique colors are available + use_offset <- n_obs <= n_palette / 2 && color_offset + n_obs <= n_palette + vctr <- get_colors_vctr( dat = sample_metadata, - palette_fun = palette_fun, - ... + colname = colname, + palette = palette, + color_offset = if (use_offset) color_offset else 0L ) + if (use_offset) { + color_offset <- color_offset + n_obs + } + color_lists[[i]] <- vctr + } names(color_lists) <- dat_colnames return(color_lists) } #' Get vector of colors for observations in one column of a data frame #' +#' Assigns one color per unique observed value in `dat[[colname]]`, drawn from +#' `palette` starting at `color_offset`. If the palette is too short, +#' falls back to `get_random_colors()`. Factor columns use factor-level order; +#' other columns use first-observed order. +#' #' @inheritParams get_colors_lst #' @param dat data frame #' @param colname column name in `dat` -#' @returns named vector of colors for each unique observation in `dat$colname` +#' @param color_offset integer; number of palette colors to skip before +#' assigning colors to this column's values. Used by [get_colors_lst()] to +#' avoid repeating colors across columns with few unique values. +#' @returns Named character vector of hex colors, one per unique observed value +#' in `dat[[colname]]`. #' @export #' +#' @examples +#' get_colors_vctr(nidap_sample_metadata, "Group") +#' get_colors_vctr(nidap_sample_metadata, "Group", color_offset = 3L) get_colors_vctr <- function( dat, colname, - palette_fun = grDevices::palette.colors, - ... + palette = mosuite_palette, + color_offset = 0L ) { - obs <- dat |> - dplyr::pull(colname) |> - unique() + obs <- get_observed_values(dat, colname) n_obs <- length(obs) - warned_cnd <- NULL - colors_vctr <- withCallingHandlers( - warning = function(cnd) { - warned_cnd <<- cnd - invokeRestart("muffleWarning") - }, - palette_fun(n = n_obs, ...) - ) + if (n_obs == 0) { + colors_vctr <- character(0) + } else { + # if fewer colors are available than needed, handle gracefully + if (length(palette) < n_obs + color_offset) { + # If an offset pushed us past the palette end but n_obs alone would fit, + # retry from the start of the palette before falling back to random colors. + if (color_offset > 0L && length(palette) >= n_obs) { + color_offset <- 0L + } + } + # If still not enough colors, fall back to random + if (length(palette) < n_obs) { + message(glue::glue( + "Number of unique values ({n_obs}) in column \"{colname}\" ", + "exceeds the palette maximum. Falling back to random colors." + )) + colors_vctr <- get_random_colors(n_obs) + } else { + colors_vctr <- palette[seq.int(color_offset + 1L, color_offset + n_obs)] + } + names(colors_vctr) <- obs + } - # if fewer colors were returned than needed (e.g. when n exceeds the palette maximum, - # such as Okabe-Ito's maximum of 9), fall back to random colors - if (length(colors_vctr) < n_obs) { - message(glue::glue( - 'Number of unique values ({n_obs}) in column "{colname}" exceeds the palette maximum. Falling back to random colors.' - )) - colors_vctr <- get_random_colors(n_obs) - } else if (!is.null(warned_cnd)) { - # warning was raised but we still have enough colors (e.g. brewer.pal warns when n < 3 - # but returns 3 colors); convert to a message and re-raise the original warning + return(colors_vctr) +} + + +#' Resolve plotting colors for one column +#' +#' Uses `color_values` when supplied; otherwise generates colors with +#' [get_colors_vctr()]. If `color_values` is named and covers all observed +#' values, it is returned as-is. If too few colors are provided, missing colors +#' are generated and appended. +#' +#' @param dat data frame +#' @param colname column name in `dat` +#' @param color_values optional named or unnamed character vector of colors +#' @param palette character vector of colors used to generate defaults +#' @returns named character vector of colors matching observed values in +#' `dat[[colname]]` +#' @keywords internal +resolve_plot_colors <- function( + dat, + colname, + color_values = NULL, + palette = mosuite_palette +) { + obs <- get_observed_values(dat, colname) + + if (length(obs) == 0) { + return(color_values) + } + + if (is.null(color_values)) { + return(get_colors_vctr(dat, colname, palette = palette)) + } + + if (!is.null(names(color_values))) { + if (all(obs %in% names(color_values))) { + return(color_values) + } + } + + if (length(color_values) < length(obs)) { + n_missing <- length(obs) - length(color_values) message(glue::glue( - 'Warning raised in get_color_vctr() for column "{colname}"' + "color_values contains {length(color_values)} colors for ", + "{length(obs)} values in column {colname}. Generating ", + "{n_missing} additional colors." )) - warning(conditionMessage(warned_cnd)) + generated_colors <- get_colors_vctr( + dat, + colname, + palette = palette + ) + color_values <- c( + unname(color_values), + unname(generated_colors)[seq.int(length(color_values) + 1, length(obs))] + ) } - # if more colors are returned than are in the observations, truncate the vector. - # this occurs when using RColorBrewer::brewer.pal with n < 3 - colors_vctr <- colors_vctr[seq_len(n_obs)] + return(stats::setNames(unname(color_values)[seq_along(obs)], obs)) +} - names(colors_vctr) <- obs - return(colors_vctr) +#' Display the mosuite color palette +#' +#' Plots each color in `mosuite_palette` as a labeled tile with its hex code +#' displayed below. The plot is rendered at a width proportional to the number +#' of colors so labels remain horizontal and legible. +#' +#' @param palette Character vector of hex color codes. Defaults to +#' `mosuite_palette`. +#' +#' @returns Invisibly returns the underlying [ggplot2::ggplot] object. +#' @export +#' +#' @examples +#' display_palette() +#' display_palette(c("#FF0000", "#00FF00", "#0000FF")) +display_palette <- function(palette = mosuite_palette) { + n <- length(palette) + + df <- data.frame( + hex = palette, + idx = factor(seq_len(n)) + ) + + p <- plot_palette(df) + + ggplot2::labs(title = "mosuite_palette") + + return(p) +} + +#' Display colors for a multiOmicDataSet object +#' +#' Plots a palette strip for each group column stored in `moo@analyses$colors`, +#' stacked vertically. Each strip shows the assigned hex colors and their codes. +#' +#' @param moo A `multiOmicDataSet` object (see +#' [create_multiOmicDataSet_from_dataframes()]). +#' @returns A [patchwork][patchwork::wrap_plots] of [ggplot2::ggplot] objects, +#' one per group column in `moo@analyses$colors`. +#' @export +#' @examples +#' moo <- create_multiOmicDataSet_from_dataframes(nidap_sample_metadata, nidap_raw_counts) +#' display_colors(moo) +display_colors <- function(moo) { + abort_packages_not_installed("patchwork") + colors_lst <- moo@analyses$colors + plots_lst <- lapply(names(colors_lst), function(colname) { + palette <- colors_lst[[colname]] + n <- length(palette) + df <- data.frame( + hex = palette, + idx = factor(seq_len(n)) + ) + return( + p <- plot_palette(df) + + ggplot2::labs(title = colname) + ) + }) + return(patchwork::wrap_plots(plots_lst, ncol = 1)) +} + +#' Plot a palette tile strip +#' +#' Renders a data frame with columns `hex` and `idx` as a row of colored tiles, +#' each labeled with its hex code. Used internally by [display_palette()] and +#' [display_colors()]. +#' +#' @param dat data frame with columns `hex` (hex color codes) and `idx` +#' (factor, used for faceting) +#' @returns a [ggplot2::ggplot] object +#' @keywords internal +plot_palette <- function(dat) { + p <- ggplot2::ggplot(dat) + + ggplot2::geom_rect( + ggplot2::aes(fill = .data$hex), + xmin = 0, + xmax = 1, + ymin = 0.25, + ymax = 1 + ) + + ggplot2::geom_text( + ggplot2::aes(label = .data$hex), + x = 0.5, + y = 0.12, + size = 2.8, + family = "mono", + vjust = 1 + ) + + ggplot2::scale_fill_identity() + + ggplot2::facet_wrap(~idx, nrow = 1) + + ggplot2::theme_void() + + ggplot2::theme( + strip.text = ggplot2::element_text( + size = 9, + margin = ggplot2::margin(b = 3) + ), + panel.spacing = ggplot2::unit(3, "pt"), + plot.title = ggplot2::element_text( + size = 12, + margin = ggplot2::margin(b = 8) + ), + plot.margin = ggplot2::margin(4, 4, 4, 4) + ) + return(p) } #' Set color palette for a single group/column @@ -127,7 +342,7 @@ get_colors_vctr <- function( #' @param moo `multiOmicDataSet` object (see `create_multiOmicDataSet_from_dataframes()`) #' @param colname group column name to set the palette for #' -#' @returns `moo` with colors updated at `moo@analyses$colors$colname` +#' @returns `moo` with colors updated at `moo@analyses$colors[[colname]]` #' @export #' #' @examples @@ -136,14 +351,14 @@ get_colors_vctr <- function( #' counts_dat = as.data.frame(nidap_raw_counts) #' ) #' moo@analyses$colors$Group -#' moo <- moo |> set_color_pal("Group", palette_fun = RColorBrewer::brewer.pal, name = "Set2") +#' moo <- moo |> set_color_pal("Group", palette = RColorBrewer::brewer.pal(3, "Set2")) #' moo@analyses$colors$Group #' #' @family moo methods set_color_pal <- S7::new_generic( "set_color_pal", "moo", - function(moo, colname, palette_fun = grDevices::palette.colors, ...) { + function(moo, colname, palette = mosuite_palette) { return(S7::S7_dispatch()) } ) @@ -151,14 +366,12 @@ set_color_pal <- S7::new_generic( S7::method(set_color_pal, multiOmicDataSet) <- function( moo, colname, - palette_fun = grDevices::palette.colors, - ... + palette = mosuite_palette ) { - moo@analyses[["colors"]][[colname]] <- get_colors_vctr( + moo@analyses$colors[[colname]] <- get_colors_vctr( dat = moo@sample_meta, colname = colname, - palette_fun = palette_fun, - ... + palette = palette ) return(moo) } diff --git a/code/MOSuite/R/counts.R b/code/MOSuite/R/counts.R index 039bded..37e708e 100644 --- a/code/MOSuite/R/counts.R +++ b/code/MOSuite/R/counts.R @@ -59,6 +59,76 @@ calc_cpm_df <- function(dat, feature_id_colname = "gene_id", ...) { return(dat_cpm |> dplyr::relocate(tidyselect::all_of(feature_id_colname))) } +#' Log-transform count columns in a data frame +#' +#' @inheritParams create_multiOmicDataSet_from_dataframes +#' @param counts_dat data frame of feature counts. +#' @param sample_colnames optional vector of sample columns to transform. If `NULL`, all columns except +#' `feature_id_colname` are transformed. +#' @param pseudocount value added before log transformation. +#' @param base logarithm base to use for the transformation. Use a numeric value, or `"e"`, `"ln"`, or `"natural"` +#' for natural log. Default is `"ln"`. +#' +#' @return count data frame with selected count columns transformed as `log(x + pseudocount, base)`. +#' @keywords internal +log_transform_counts <- function( + counts_dat, + feature_id_colname = NULL, + sample_colnames = NULL, + pseudocount = 0.5, + base = "ln" +) { + if (is.null(feature_id_colname)) { + feature_id_colname <- colnames(counts_dat)[1] + } + if (is.null(sample_colnames)) { + sample_colnames <- setdiff(colnames(counts_dat), feature_id_colname) + } + if (!is.numeric(pseudocount) || length(pseudocount) != 1) { + stop("pseudocount must be a single numeric value") + } + if (pseudocount < 0) { + stop("pseudocount cannot be negative") + } + base <- resolve_log_transform_base(base) + if ( + any( + as.matrix(counts_dat[, sample_colnames, drop = FALSE]) + pseudocount <= 0, + na.rm = TRUE + ) + ) { + stop( + "log_transform_counts requires all count values plus pseudocount to be greater than 0" + ) + } + counts_dat |> + dplyr::mutate(dplyr::across( + tidyselect::all_of(sample_colnames), + ~ log(.x + pseudocount, base = base) + )) +} + +resolve_log_transform_base <- function(base) { + if (is.character(base) && length(base) == 1) { + base <- tolower(base) + if (base %in% c("e", "ln", "natural")) { + return(exp(1)) + } + stop( + "base must be a single numeric value or one of 'e', 'ln', or 'natural'" + ) + } + if (!is.numeric(base) || length(base) != 1) { + stop( + "base must be a single numeric value or one of 'e', 'ln', or 'natural'" + ) + } + if (base <= 0 || base == 1) { + stop("base must be greater than 0 and cannot equal 1") + } + return(base) +} + #' Convert a data frame of gene counts to a matrix #' #' @inheritParams create_multiOmicDataSet_from_dataframes diff --git a/code/MOSuite/R/data.R b/code/MOSuite/R/data.R index f27fb3b..23f2561 100644 --- a/code/MOSuite/R/data.R +++ b/code/MOSuite/R/data.R @@ -64,3 +64,17 @@ #' The result of running `plot_venn_diagram()` on `nidap_volcano_summary_dat` #' @keywords data "nidap_venn_diagram_dat" + +#' Default MOSuite color palette +#' +#' A character vector of 12 hex color codes used as the default palette throughout MOSuite plots. +#' Colors are assigned to groups in the order they appear (or by factor level order). +#' Use [set_color_pal()] to override the palette for a specific metadata column. +#' +#' @format A character vector of length 12. +#' @seealso [select_mosuite_colors()], [set_color_pal()] +#' @keywords data +#' @examples +#' mosuite_palette +#' scales::show_col(mosuite_palette) +"mosuite_palette" diff --git a/code/MOSuite/R/differential.R b/code/MOSuite/R/differential.R index 3adf34c..fd16d21 100644 --- a/code/MOSuite/R/differential.R +++ b/code/MOSuite/R/differential.R @@ -15,7 +15,7 @@ #' @param return_mean_and_sd if TRUE, return Mean and Standard Deviation of groups in addition to DEG estimates for #' contrast(s) #' -#' @returns `multiOmicDataSet` with `diff` added to the `analyses` slot (i.e. `moo@analyses$diff`) +#' @returns `multiOmicDataSet` with `diff` added to the `analyses` slot (i.e. `moo@analyses[["diff"]]`) #' @export #' #' @family moo methods @@ -485,7 +485,7 @@ get_gene_lists <- function( ) { upreg_genes <- list() downreg_genes <- list() - for (i in seq_len(length(contrasts))) { + for (i in seq_along(contrasts)) { if (pval == "pval") { upreg_genes[[i]] <- finalres |> dplyr::filter( diff --git a/code/MOSuite/R/filter.R b/code/MOSuite/R/filter.R index b520ef1..5bddf68 100644 --- a/code/MOSuite/R/filter.R +++ b/code/MOSuite/R/filter.R @@ -33,10 +33,10 @@ #' column showing to which experimental treatments each sample belongs (e.g. WildType, Knockout, Tumor, Normal, #' Before, After, etc.). #' @param label_colname The column from the sample metadata containing the sample labels as you wish them to appear in -#' the plots produced by this template. This can be the same Sample Names Column. However, you may desire different -#' labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the -#' column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: -#' `NULL` -- `sample_id_colname` will be used.) +#' heatmap and PCA figures. This can be the same Sample Names Column. However, you may desire different labels to +#' display on your figures (e.g. shorter labels are sometimes preferred on plots). In that case, select the column with +#' your preferred Labels here. The selected column should contain unique names for each sample. Use `add_label_to_pca` +#' to control whether these labels are displayed on the PCA plot. #' @param samples_to_include Which samples would you like to include? Usually, you will choose all sample columns, or #' you could choose to remove certain samples. Samples excluded here will be removed in this step and from further #' analysis downstream of this step. (Default: `NULL` - all sample IDs in `moo@sample_meta` will be used.) @@ -45,19 +45,23 @@ #' been transformed (eg log2, CPM, FPKM or some form of Normalization) set to FALSE. If FALSE no further #' transformation will be applied and features will be filtered as is. For RNAseq data RAW counts should be #' transformed to CPM in order to properly filter. -#' @param minimum_count_value_to_be_considered_nonzero Minimum count value to be considered non-zero for a sample -#' @param minimum_number_of_samples_with_nonzero_counts_in_total Minimum number of samples (total) with non-zero counts +#' @param minimum_count_value_to_be_considered_nonzero Minimum value in the selected filtering table required for a +#' sample to be considered nonzero. If `use_cpm_counts_to_filter` is `TRUE`, this threshold is applied to CPM values. +#' If `use_cpm_counts_to_filter` is `FALSE`, this threshold is applied directly to the selected `count_type` table. +#' @param minimum_number_of_samples_with_nonzero_counts_in_total Minimum number of samples in total that must meet the +#' `minimum_count_value_to_be_considered_nonzero` threshold for a feature to be kept. #' @param use_group_based_filtering If TRUE, only keeps features (e.g. genes) that have at least a certain number of -#' samples with nonzero CPM counts in at least one group +#' samples passing the threshold in at least one group #' @param minimum_number_of_samples_with_nonzero_counts_in_a_group Only keeps genes that have at least this number of -#' samples with nonzero CPM counts in at least one group +#' samples meeting the threshold in at least one group #' @param principal_component_on_x_axis The principal component to plot on the x-axis for the PCA plot. Choices include #' 1, 2, 3, ... (default: 1) #' @param principal_component_on_y_axis The principal component to plot on the y-axis for the PCA plot. Choices include #' 1, 2, 3, ... (default: 2) #' @param legend_position_for_pca legend position for the PCA plot #' @param point_size_for_pca geom point size for the PCA plot -#' @param add_label_to_pca label points on the PCA plot +#' @param add_label_to_pca If `TRUE`, display labels from `label_colname` on PCA points. If `FALSE`, the PCA plot uses +#' unlabeled points while heatmap labels still use `label_colname`. #' @param label_font_size label font size for the PCA plot #' @param label_offset_y_ label offset y for the PCA plot #' @param label_offset_x_ label offset x for the PCA plot @@ -66,16 +70,23 @@ #' renaming. Use the following format to describe which old name (in your sample metadata table) you want to rename to #' which new name: old_name: new_name #' @param color_histogram_by_group Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by -#' the column you select in the "Group Column Used to Color Histogram" parameter (below). Default is FALSE. +#' the column you select in the "Group Column Used to Color Histogram" parameter (below). Default is TRUE. #' @param set_min_max_for_x_axis_for_histogram whether to set min/max value for histogram x-axis #' @param minimum_for_x_axis_for_histogram x-axis minimum for histogram plot #' @param maximum_for_x_axis_for_histogram x-axis maximum for histogram plot #' @param legend_position_for_histogram legend position for the histogram plot. consider setting to 'none' for a large #' number of samples. -#' @param legend_font_size_for_histogram legend font size for the histogram plot +#' @param legend_font_size_for_histogram legend font size for the histogram plot. +#' If `NULL`, the size is scaled automatically. #' @param number_of_histogram_legend_columns number of columns for the histogram legend -#' @param colors_for_plots Colors for the PCA and histogram will be picked, in order, from this list. +#' @param colors_for_plots Optional colors for PCA/histogram/heatmap plots. If `NULL`, colors are taken from +#' `moo@analyses$colors[[group_colname]]`. #' Colors must either be names in `grDevices::colors()` or valid hex codes. +#' Unnamed colors are assigned by factor level order when the grouping column is a factor; +#' otherwise, they follow the order in which groups first appear in the metadata column. If more groups are present +#' than colors provided, +#' supplied colors are used first and additional colors are generated from the selected palette for the remaining +#' groups; random colors are used only if that palette returns fewer colors than the number of groups. #' @param plot_corr_matrix_heatmap Datasets with a large number of samples may be too large to create a correlation #' matrix heatmap. If this function takes longer than 5 minutes to run, Set to `FALSE` and the correlation matrix will #' not be be created. Default is `TRUE`. @@ -106,7 +117,7 @@ filter_counts <- function( feature_id_colname = NULL, sample_id_colname = NULL, group_colname = "Group", - label_colname = NULL, + label_colname = "Label", samples_to_include = NULL, minimum_count_value_to_be_considered_nonzero = 8, minimum_number_of_samples_with_nonzero_counts_in_total = 7, @@ -116,18 +127,18 @@ filter_counts <- function( principal_component_on_x_axis = 1, principal_component_on_y_axis = 2, legend_position_for_pca = "top", - point_size_for_pca = 1, + point_size_for_pca = 5, add_label_to_pca = TRUE, label_font_size = 3, label_offset_y_ = 2, label_offset_x_ = 2, samples_to_rename = c(""), - color_histogram_by_group = FALSE, + color_histogram_by_group = TRUE, set_min_max_for_x_axis_for_histogram = FALSE, minimum_for_x_axis_for_histogram = -1, maximum_for_x_axis_for_histogram = 1, legend_position_for_histogram = "top", - legend_font_size_for_histogram = 10, + legend_font_size_for_histogram = NULL, number_of_histogram_legend_columns = 6, colors_for_plots = NULL, plot_corr_matrix_heatmap = TRUE, @@ -151,6 +162,7 @@ filter_counts <- function( if (is.null(samples_to_include)) { samples_to_include <- sample_metadata |> dplyr::pull(sample_id_colname) } + pca_label_colname <- if (isTRUE(add_label_to_pca)) label_colname else NULL if (is.null(label_colname)) { label_colname <- sample_id_colname } @@ -168,6 +180,7 @@ filter_counts <- function( df_filt <- remove_low_count_genes( counts_dat = df, sample_metadata = sample_metadata, + sample_id_colname = sample_id_colname, feature_id_colname = feature_id_colname, group_colname = group_colname, use_cpm_counts_to_filter = use_cpm_counts_to_filter, @@ -176,35 +189,38 @@ filter_counts <- function( minimum_number_of_samples_with_nonzero_counts_in_total = minimum_number_of_samples_with_nonzero_counts_in_total, minimum_number_of_samples_with_nonzero_counts_in_a_group = minimum_number_of_samples_with_nonzero_counts_in_a_group ) - message(glue::glue("colors_for_plots {class(colors_for_plots)}")) + if (nrow(df_filt) == 0) { + warning( + "No features remain after filtering. ", + "Consider relaxing the filtering thresholds ", + "(e.g. minimum_count_value_to_be_considered_nonzero, ", + "minimum_number_of_samples_with_nonzero_counts_in_total, or ", + "minimum_number_of_samples_with_nonzero_counts_in_a_group). ", + "Skipping QC plots." + ) + moo@counts[["filt"]] <- df[0, ] + return(moo) + } + if (isTRUE(print_plots) || isTRUE(save_plots)) { # use consistent colors - if (is.null(colors_for_plots)) { - colors_for_plots <- moo@analyses[["colors"]][[group_colname]] - } else { - colors_for_plots <- as.vector(colors_for_plots) - } + colors_for_plots <- colors_for_plots %||% + moo@analyses$colors[[group_colname]] + if (isTRUE(color_histogram_by_group)) { colors_for_histogram <- colors_for_plots } else { - colors_for_histogram <- moo@analyses[["colors"]][[label_colname]] + colors_for_histogram <- moo@analyses$colors[[label_colname]] } - message(glue::glue("colors_for_plots {class(colors_for_plots)}")) - - log_counts <- df_filt |> - dplyr::mutate(dplyr::across( - tidyselect::all_of(samples_to_include), - ~ log(.x + 0.5) - )) pca_plot <- plot_pca( - log_counts, + df_filt, sample_metadata = sample_metadata, sample_id_colname = sample_id_colname, feature_id_colname = feature_id_colname, samples_to_rename = samples_to_rename, group_colname = group_colname, - label_colname = label_colname, + label_colname = pca_label_colname, color_values = colors_for_plots, principal_components = c( principal_component_on_x_axis, @@ -212,17 +228,30 @@ filter_counts <- function( ), legend_position = legend_position_for_pca, point_size = point_size_for_pca, - add_label = add_label_to_pca, label_font_size = label_font_size, label_offset_y_ = label_offset_y_, label_offset_x_ = label_offset_x_, + log_transform = TRUE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", print_plots = FALSE, save_plots = FALSE ) + ggplot2::labs(caption = "filtered counts") + # Histogram data and axis setup + histogram_x_axis_label <- if (isTRUE(use_cpm_counts_to_filter)) { + "CPM" + } else { + "Count" + } + log2_axis_pseudocount <- 0.5 + histogram_threshold_x <- minimum_count_value_to_be_considered_nonzero + + log2_axis_pseudocount + + # Base histogram plot hist_plot <- plot_histogram( - log_counts, + df_filt, sample_metadata, sample_id_colname = sample_id_colname, feature_id_colname = feature_id_colname, @@ -233,11 +262,38 @@ filter_counts <- function( set_min_max_for_x_axis = set_min_max_for_x_axis_for_histogram, minimum_for_x_axis = minimum_for_x_axis_for_histogram, maximum_for_x_axis = maximum_for_x_axis_for_histogram, + x_axis_label = histogram_x_axis_label, legend_position = legend_position_for_histogram, legend_font_size = legend_font_size_for_histogram, - number_of_legend_columns = number_of_histogram_legend_columns + number_of_legend_columns = number_of_histogram_legend_columns, + interactive_plots = interactive_plots, + return_ggplot = TRUE, + use_log2_x_axis = TRUE ) + ggplot2::labs(caption = "filtered counts") + + # Filtering threshold marker + hist_plot <- hist_plot + + ggplot2::geom_vline( + xintercept = histogram_threshold_x, + linetype = 2, + linewidth = 1 + ) + + ggplot2::annotate( + "text", + x = histogram_threshold_x, + y = Inf, + label = if (isTRUE(use_cpm_counts_to_filter)) { + glue::glue("CPM: {minimum_count_value_to_be_considered_nonzero}") + } else { + glue::glue("Count: {minimum_count_value_to_be_considered_nonzero}") + }, + hjust = -0.05, + vjust = 1.5, + size = 3 + ) + + # Correlation heatmap plot if (isTRUE(plot_corr_matrix_heatmap)) { corHM <- plot_corr_heatmap( df_filt[, samples_to_include], @@ -257,19 +313,33 @@ filter_counts <- function( ) } + # Interactive plot conversion plot_ext <- "png" if (isTRUE(interactive_plots)) { - pca_plot <- pca_plot |> plotly::ggplotly(tooltip = c("sample", "group")) - hist_plot <- (hist_plot + ggplot2::theme(legend.position = "none")) |> - plotly::ggplotly(tooltip = c("sample")) + pca_plot <- pca_plot |> plotly::ggplotly(tooltip = "text") + hist_plot <- hist_plot |> plotly::ggplotly(tooltip = "text") plot_ext <- "html" } - print_or_save_plot( - pca_plot, - filename = file.path(plots_subdir, glue::glue("pca.{plot_ext}")), - print_plots = print_plots, - save_plots = save_plots - ) + + # Save or print PCA and histogram plots + if (identical(plot_ext, "png")) { + print_or_save_plot( + pca_plot, + filename = file.path(plots_subdir, glue::glue("pca.{plot_ext}")), + print_plots = print_plots, + save_plots = save_plots, + width = 7, + height = 7, + units = "in" + ) + } else { + print_or_save_plot( + pca_plot, + filename = file.path(plots_subdir, glue::glue("pca.{plot_ext}")), + print_plots = print_plots, + save_plots = save_plots + ) + } print_or_save_plot( hist_plot, filename = file.path(plots_subdir, glue::glue("histogram.{plot_ext}")), @@ -300,6 +370,7 @@ filter_counts <- function( remove_low_count_genes <- function( counts_dat, sample_metadata, + sample_id_colname = NULL, feature_id_colname, group_colname, use_cpm_counts_to_filter = TRUE, @@ -308,52 +379,78 @@ remove_low_count_genes <- function( minimum_number_of_samples_with_nonzero_counts_in_total = 7, minimum_number_of_samples_with_nonzero_counts_in_a_group = 3 ) { - # TODO refactor with tidyverse - value <- isexpr1 <- NULL df <- counts_dat df <- df[stats::complete.cases(df), ] + if (is.null(sample_id_colname)) { + sample_id_colname <- colnames(sample_metadata)[1] + } + sample_colnames <- setdiff(colnames(df), feature_id_colname) + sample_colnames <- sample_colnames[vapply( + df[sample_colnames], + is.numeric, + logical(1) + )] # USE CPM Transformation trans_df <- df if (use_cpm_counts_to_filter == TRUE) { - trans_df[, -1] <- edgeR::cpm(as.matrix(df[, -1])) + trans_df[, sample_colnames] <- edgeR::cpm(as.matrix(df[, sample_colnames])) } + passing_counts <- as.matrix(trans_df[, sample_colnames, drop = FALSE]) >= + minimum_count_value_to_be_considered_nonzero if (use_group_based_filtering == TRUE) { - rownames(trans_df) <- trans_df[, feature_id_colname] - trans_df[, feature_id_colname] <- NULL - - counts <- trans_df >= minimum_count_value_to_be_considered_nonzero # boolean matrix - - tcounts <- as.data.frame(t(counts)) - colnum <- dim(counts)[1] # number of genes - tcounts <- merge(sample_metadata[group_colname], tcounts, by = "row.names") - tcounts$Row.names <- NULL - melted <- reshape2::melt(tcounts, id.vars = group_colname) - tcounts.tot <- dplyr::summarise( - dplyr::group_by_at(melted, c(group_colname, "variable")), - sum = sum(value) + if (!(sample_id_colname %in% colnames(sample_metadata))) { + stop(glue::glue( + "sample_id_colname {sample_id_colname} not in sample_metadata" + )) + } + if (!(group_colname %in% colnames(sample_metadata))) { + stop(glue::glue("group_colname {group_colname} not in sample_metadata")) + } + sample_match <- match( + sample_colnames, + as.character(sample_metadata[[sample_id_colname]]) ) - tcounts.group <- tcounts.tot |> - tidyr::pivot_wider(names_from = "variable", values_from = "sum") |> - as.data.frame() - tcounts.keep <- colSums( - tcounts.group[(1:colnum + 1)] >= + if (anyNA(sample_match)) { + missing_samples <- sample_colnames[is.na(sample_match)] + stop(glue::glue( + "sample_metadata is missing sample IDs: ", + "{glue::glue_collapse(missing_samples, sep = ', ')}" + )) + } + sample_groups <- as.character(sample_metadata[[group_colname]][ + sample_match + ]) + groups <- unique(stats::na.omit(sample_groups)) + if (length(groups) == 0) { + stop(glue::glue( + "group_colname {group_colname} has no non-missing values for selected samples" + )) + } + passing_samples_by_group <- vapply( + groups, + function(group) { + group_sample_colnames <- sample_colnames[ + !is.na(sample_groups) & sample_groups == group + ] + rowSums(passing_counts[, group_sample_colnames, drop = FALSE]) + }, + numeric(nrow(passing_counts)) + ) + keep_rows <- rowSums( + passing_samples_by_group >= minimum_number_of_samples_with_nonzero_counts_in_a_group ) >= 1 - df_filt <- trans_df[tcounts.keep, ] |> - tibble::rownames_to_column(feature_id_colname) + df_filt <- trans_df[keep_rows, , drop = FALSE] } else { - trans_df$isexpr1 <- (rowSums( - as.matrix(trans_df[, -1]) > minimum_count_value_to_be_considered_nonzero - ) >= + keep_rows <- (rowSums(passing_counts) >= minimum_number_of_samples_with_nonzero_counts_in_total) - df_filt <- trans_df |> - dplyr::filter(isexpr1) |> - dplyr::select(-isexpr1) + df_filt <- trans_df[keep_rows, , drop = FALSE] } + rownames(df_filt) <- NULL message(paste0("Number of features after filtering: ", nrow(df_filt))) return(df_filt) diff --git a/code/MOSuite/R/normalize.R b/code/MOSuite/R/normalize.R index 4823217..4daf5f0 100644 --- a/code/MOSuite/R/normalize.R +++ b/code/MOSuite/R/normalize.R @@ -34,7 +34,7 @@ normalize_counts <- function( samples_to_include = NULL, sample_id_colname = NULL, group_colname = "Group", - label_colname = NULL, + label_colname = "Label", input_in_log_counts = FALSE, voom_normalization_method = "quantile", samples_to_rename = c(""), @@ -45,12 +45,12 @@ normalize_counts <- function( label_offset_x_ = 2, label_offset_y_ = 2, label_font_size = 3, - point_size_for_pca = 8, + point_size_for_pca = 5, color_histogram_by_group = TRUE, set_min_max_for_x_axis_for_histogram = FALSE, minimum_for_x_axis_for_histogram = -1, maximum_for_x_axis_for_histogram = 1, - legend_font_size_for_histogram = 10, + legend_font_size_for_histogram = NULL, legend_position_for_histogram = "top", number_of_histogram_legend_columns = 6, plot_corr_matrix_heatmap = TRUE, @@ -72,6 +72,7 @@ normalize_counts <- function( if (is.null(samples_to_include)) { samples_to_include <- sample_metadata |> dplyr::pull(sample_id_colname) } + pca_label_colname <- if (isTRUE(add_label_to_pca)) label_colname else NULL if (is.null(label_colname)) { label_colname <- sample_id_colname } @@ -103,13 +104,13 @@ normalize_counts <- function( message(paste0("Total number of features included: ", nrow(df.voom))) ### PH: END Limma Normalization if (isTRUE(print_plots) || isTRUE(save_plots)) { - if (is.null(colors_for_plots)) { - colors_for_plots <- moo@analyses[["colors"]][[group_colname]] - } + colors_for_plots <- colors_for_plots %||% + moo@analyses$colors[[group_colname]] + if (isTRUE(color_histogram_by_group)) { colors_for_histogram <- colors_for_plots } else { - colors_for_histogram <- moo@analyses[["colors"]][[label_colname]] + colors_for_histogram <- moo@analyses$colors[[label_colname]] } pca_plot <- plot_pca( df.voom, @@ -117,7 +118,7 @@ normalize_counts <- function( sample_id_colname = sample_id_colname, samples_to_rename = samples_to_rename, group_colname = group_colname, - label_colname = label_colname, + label_colname = pca_label_colname, color_values = colors_for_plots, principal_components = c( principal_component_on_x_axis, @@ -125,10 +126,10 @@ normalize_counts <- function( ), legend_position = legend_position_for_pca, point_size = point_size_for_pca, - add_label = add_label_to_pca, label_font_size = label_font_size, label_offset_y_ = label_offset_y_, label_offset_x_ = label_offset_x_, + log_transform = FALSE, print_plots = FALSE, save_plots = FALSE ) + @@ -143,11 +144,17 @@ normalize_counts <- function( color_values = colors_for_histogram, color_by_group = color_histogram_by_group, x_axis_label = "Normalized Counts", + set_min_max_for_x_axis = set_min_max_for_x_axis_for_histogram, + minimum_for_x_axis = minimum_for_x_axis_for_histogram, + maximum_for_x_axis = maximum_for_x_axis_for_histogram, legend_position = legend_position_for_histogram, legend_font_size = legend_font_size_for_histogram, - number_of_legend_columns = number_of_histogram_legend_columns - ) + - ggplot2::labs(caption = "normalized counts") + number_of_legend_columns = number_of_histogram_legend_columns, + interactive_plots = interactive_plots + ) + if (!isTRUE(interactive_plots)) { + hist_plot <- hist_plot + ggplot2::labs(caption = "normalized counts") + } if (isTRUE(plot_corr_matrix_heatmap)) { corHM_plot <- plot_corr_heatmap( df.filt, @@ -166,16 +173,32 @@ normalize_counts <- function( caption = "normalized counts" ) } - - print_or_save_plot( - pca_plot, - filename = file.path(plots_subdir, "pca.png"), - print_plots = print_plots, - save_plots = save_plots - ) + plot_ext <- "png" + if (isTRUE(interactive_plots)) { + pca_plot <- pca_plot |> plotly::ggplotly(tooltip = "text") + plot_ext <- "html" + } + if (identical(plot_ext, "png")) { + print_or_save_plot( + pca_plot, + filename = file.path(plots_subdir, glue::glue("pca.{plot_ext}")), + print_plots = print_plots, + save_plots = save_plots, + width = 7, + height = 7, + units = "in" + ) + } else { + print_or_save_plot( + pca_plot, + filename = file.path(plots_subdir, glue::glue("pca.{plot_ext}")), + print_plots = print_plots, + save_plots = save_plots + ) + } print_or_save_plot( hist_plot, - filename = file.path(plots_subdir, "histogram.png"), + filename = file.path(plots_subdir, glue::glue("histogram.{plot_ext}")), print_plots = print_plots, save_plots = save_plots ) diff --git a/code/MOSuite/R/plot_heatmap.R b/code/MOSuite/R/plot_heatmap.R index 879f0ee..e3dea29 100644 --- a/code/MOSuite/R/plot_heatmap.R +++ b/code/MOSuite/R/plot_heatmap.R @@ -42,10 +42,7 @@ #' feature_id_colname = NULL, #' group_colname = "Group", #' label_colname = "Label", -#' color_values = c( -#' "#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", -#' "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500" -#' )) +#' color_values = mosuite_palette) #' ``` #' #' @seealso @@ -64,6 +61,13 @@ plot_corr_heatmap <- S7::new_generic("plot_corr_heatmap", "moo_counts") #' @param count_type the type of counts to use. Must be a name in the counts slot (`names(moo@counts)`). #' @param sub_count_type used if `count_type` is a list in the counts slot: specify the sub count type within the list. #' Must be a name in `names(moo@counts[[count_type]])`. +#' @param group_colname The column from the sample metadata containing the sample group information. This is usually a +#' column showing to which experimental treatments each sample belongs (e.g. WildType, Knockout, Tumor, Normal, +#' Before, After, etc.). +#' @param color_values vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +#' level order when the grouping column is a factor; otherwise, they are assigned in the order groups first appear in +#' the metadata column. Defaults to `NULL`; when `NULL`, `mosuite_palette` is used for `data.frame` dispatch and +#' stored colors are used for `multiOmicDataSet` dispatch. #' @param ... additional arguments forwarded to [plot_corr_heatmap()] for `data.frame` #' #' @rdname plot_corr_heatmap-multiOmicDataSet @@ -76,12 +80,17 @@ S7::method(plot_corr_heatmap, multiOmicDataSet) <- function( moo_counts, count_type, sub_count_type = NULL, + group_colname = "Group", + color_values = NULL, ... ) { counts_dat <- extract_counts(moo_counts, count_type, sub_count_type) + color_values <- color_values %||% moo_counts@analyses$colors[group_colname] return(plot_corr_heatmap( counts_dat, sample_metadata = moo_counts@sample_meta, + group_colname = group_colname, + color_values = color_values, ... )) } @@ -105,7 +114,9 @@ S7::method(plot_corr_heatmap, multiOmicDataSet) <- function( #' labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the #' column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: #' `NULL` -- `sample_id_colname` will be used.) -#' @param color_values vector of colors as hex values or names recognized by R +#' @param color_values vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +#' level order when the grouping column is a factor; otherwise, they are assigned in the order groups first appear in +#' the metadata column. Defaults to `NULL`; when `NULL`, `mosuite_palette` is used. #' #' @rdname plot_corr_heatmap-data.frame #' @aliases plot_corr_heatmap.data.frame @@ -120,22 +131,10 @@ S7::method(plot_corr_heatmap, S7::class_data.frame) <- function( feature_id_colname = NULL, group_colname = "Group", label_colname = "Label", - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ) + color_values = NULL ) { abort_packages_not_installed("amap", "ComplexHeatmap", "dendsort") + color_values <- color_values %||% mosuite_palette counts_dat <- moo_counts if (is.null(sample_id_colname)) { sample_id_colname <- colnames(sample_metadata)[1] @@ -154,20 +153,15 @@ S7::method(plot_corr_heatmap, S7::class_data.frame) <- function( # cannot set rownames on a tibble sample_metadata <- sample_metadata |> as.data.frame() rownames(sample_metadata) <- sample_metadata[[label_colname]] - annoVal <- lapply(group_colname, function(x) { - # TODO this only works on dataframes, not tibbles - out <- as.factor(sample_metadata |> dplyr::pull(x)) |> levels() - # names(out)=x - return(out) - }) |> - unlist() - col <- color_values[seq_along(annoVal)] - names(col) <- annoVal - + # normalize color_values to a named list so each column can have its own colors + if (!is.list(color_values)) { + color_values <- stats::setNames( + rep(list(color_values), length(group_colname)), + group_colname + ) + } cols <- lapply(group_colname, function(x) { - ax <- as.factor(sample_metadata |> dplyr::pull(x)) |> levels() - out <- col[ax] - return(out) + return(resolve_plot_colors(sample_metadata, x, color_values[[x]])) }) names(cols) <- (group_colname) @@ -255,7 +249,10 @@ S7::method(plot_corr_heatmap, S7::class_data.frame) <- function( #' labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the #' column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: #' `NULL` -- `sample_id_colname` will be used.) -#' @param color_values vector of colors as hex values or names recognized by R +#' @param color_values vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +#' level order when the grouping column is a factor; otherwise, they are assigned in the order groups first appear in +#' the metadata column. Defaults to `NULL`; when `NULL`, `mosuite_palette` is used for `data.frame` dispatch and +#' stored colors are used for `multiOmicDataSet` dispatch. #' @param samples_to_include Which samples would you like to include? Usually, you will choose all sample columns, or #' you could choose to remove certain samples. Samples excluded here will be removed in this step and from further #' analysis downstream of this step. (Default: `NULL` - all sample IDs in `moo@sample_meta` will be used.) @@ -295,7 +292,6 @@ S7::method(plot_corr_heatmap, S7::class_data.frame) <- function( #' @param assign_group_colors If TRUE, set the groups assigned colors (below) #' @param assign_color_to_sample_groups Enter each sample to color in the format: group_name: color This parameter is #' ignored if "Assign Colors" is set to FALSE. -#' @param group_colors Set group annotation colors. #' @param heatmap_color_scheme color scheme (TODO document options) #' @param autoscale_heatmap_color Set to TRUE to autoscale the heatmap colors between the maximum and minimum heatmap #' color parameters. If FALSE, set the heatmap colors between "Set max heatmap color" and "Set min heatmap color" @@ -312,6 +308,7 @@ S7::method(plot_corr_heatmap, S7::class_data.frame) <- function( #' @param display_numbers Setting to FALSE (default) will not display numerical value of heat on heatmap. Set to TRUE if #' you want to see these numbers on the plot. #' @param plot_filename plot output filename - only used if save_plots is TRUE +#' @param ... additional arguments passed to methods #' #' @export #' @returns heatmap from `ComplexHeatmap::Heatmap()` @@ -365,20 +362,7 @@ plot_expr_heatmap <- S7::new_generic( group_colname = "Group", label_colname = NULL, samples_to_include = NULL, - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + color_values = NULL, include_all_genes = FALSE, filter_top_genes_by_variance = TRUE, top_genes_by_variance_to_include = 500, @@ -403,20 +387,6 @@ plot_expr_heatmap <- S7::new_generic( group_columns = c("Group", "Replicate", "Batch"), assign_group_colors = FALSE, assign_color_to_sample_groups = c(), - group_colors = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), heatmap_color_scheme = "Default", autoscale_heatmap_color = TRUE, set_min_heatmap_color = -2, @@ -429,7 +399,8 @@ plot_expr_heatmap <- S7::new_generic( plot_filename = "expr_heatmap.png", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "heatmap" + plots_subdir = "heatmap", + ... ) { return(S7::S7_dispatch()) } @@ -447,20 +418,7 @@ S7::method(plot_expr_heatmap, multiOmicDataSet) <- function( group_colname = "Group", label_colname = NULL, samples_to_include = NULL, - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + color_values = NULL, include_all_genes = FALSE, filter_top_genes_by_variance = TRUE, top_genes_by_variance_to_include = 500, @@ -485,20 +443,6 @@ S7::method(plot_expr_heatmap, multiOmicDataSet) <- function( group_columns = c("Group", "Replicate", "Batch"), assign_group_colors = FALSE, assign_color_to_sample_groups = c(), - group_colors = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), heatmap_color_scheme = "Default", autoscale_heatmap_color = TRUE, set_min_heatmap_color = -2, @@ -511,58 +455,59 @@ S7::method(plot_expr_heatmap, multiOmicDataSet) <- function( plot_filename = "expr_heatmap.png", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "heatmap" + plots_subdir = "heatmap", + ... ) { counts_dat <- extract_counts(moo_counts, count_type, sub_count_type) + color_values <- color_values %||% moo_counts@analyses$colors[group_columns] heatmap_plot <- plot_expr_heatmap( counts_dat, count_type = count_type, sub_count_type = sub_count_type, sample_metadata = moo_counts@sample_meta, sample_id_colname = NULL, - feature_id_colname, - group_colname, - label_colname, - samples_to_include, - color_values, - include_all_genes, - filter_top_genes_by_variance, - top_genes_by_variance_to_include, - specific_genes_to_include_in_heatmap, - cluster_genes, - gene_distance_metric, - gene_clustering_method, - display_gene_dendrograms, - display_gene_names, - center_and_rescale_expression, - cluster_samples, - arrange_sample_columns, - order_by_gene_expression, - gene_to_order_columns, - gene_expression_order, - smpl_distance_metric, - smpl_clustering_method, - display_smpl_dendrograms, - reorder_dendrogram, - reorder_dendrogram_order, - display_sample_names, - group_columns, - assign_group_colors, - assign_color_to_sample_groups, - group_colors, - heatmap_color_scheme, - autoscale_heatmap_color, - set_min_heatmap_color, - set_max_heatmap_color, - aspect_ratio, - legend_font_size, - gene_name_font_size, - sample_name_font_size, - display_numbers, + feature_id_colname = feature_id_colname, + group_colname = group_colname, + label_colname = label_colname, + samples_to_include = samples_to_include, + color_values = color_values, + include_all_genes = include_all_genes, + filter_top_genes_by_variance = filter_top_genes_by_variance, + top_genes_by_variance_to_include = top_genes_by_variance_to_include, + specific_genes_to_include_in_heatmap = specific_genes_to_include_in_heatmap, + cluster_genes = cluster_genes, + gene_distance_metric = gene_distance_metric, + gene_clustering_method = gene_clustering_method, + display_gene_dendrograms = display_gene_dendrograms, + display_gene_names = display_gene_names, + center_and_rescale_expression = center_and_rescale_expression, + cluster_samples = cluster_samples, + arrange_sample_columns = arrange_sample_columns, + order_by_gene_expression = order_by_gene_expression, + gene_to_order_columns = gene_to_order_columns, + gene_expression_order = gene_expression_order, + smpl_distance_metric = smpl_distance_metric, + smpl_clustering_method = smpl_clustering_method, + display_smpl_dendrograms = display_smpl_dendrograms, + reorder_dendrogram = reorder_dendrogram, + reorder_dendrogram_order = reorder_dendrogram_order, + display_sample_names = display_sample_names, + group_columns = group_columns, + assign_group_colors = assign_group_colors, + assign_color_to_sample_groups = assign_color_to_sample_groups, + heatmap_color_scheme = heatmap_color_scheme, + autoscale_heatmap_color = autoscale_heatmap_color, + set_min_heatmap_color = set_min_heatmap_color, + set_max_heatmap_color = set_max_heatmap_color, + aspect_ratio = aspect_ratio, + legend_font_size = legend_font_size, + gene_name_font_size = gene_name_font_size, + sample_name_font_size = sample_name_font_size, + display_numbers = display_numbers, plot_filename = plot_filename, - print_plots, - save_plots, - plots_subdir + print_plots = print_plots, + save_plots = save_plots, + plots_subdir = plots_subdir ) return(heatmap_plot) } @@ -578,20 +523,7 @@ S7::method(plot_expr_heatmap, S7::class_data.frame) <- function( group_colname = "Group", label_colname = NULL, samples_to_include = NULL, - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + color_values = NULL, include_all_genes = FALSE, filter_top_genes_by_variance = TRUE, top_genes_by_variance_to_include = 500, @@ -616,20 +548,6 @@ S7::method(plot_expr_heatmap, S7::class_data.frame) <- function( group_columns = c("Group", "Replicate", "Batch"), assign_group_colors = FALSE, assign_color_to_sample_groups = c(), - group_colors = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), heatmap_color_scheme = "Default", autoscale_heatmap_color = TRUE, set_min_heatmap_color = -2, @@ -642,10 +560,12 @@ S7::method(plot_expr_heatmap, S7::class_data.frame) <- function( plot_filename = "expr_heatmap.png", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "heatmap" + plots_subdir = "heatmap", + ... ) { ## This function uses pheatmap to draw a heatmap, scaling first by rows ## (with samples in columns and genes in rows) + color_values <- color_values %||% mosuite_palette Gene <- NULL # TODO support tibbles; currently these must be dataframes counts_dat <- as.data.frame(moo_counts) @@ -749,9 +669,6 @@ S7::method(plot_expr_heatmap, S7::class_data.frame) <- function( # if (=FALSE) { # col.pal = rev(col.pal) # } - # Define metrics for clustering - drows1 <- gene_distance_metric - dcols1 <- smpl_distance_metric minx <- min(dat) maxx <- max(dat) if (autoscale_heatmap_color) { @@ -763,31 +680,58 @@ S7::method(plot_expr_heatmap, S7::class_data.frame) <- function( } breaks <- sapply(breaks, signif, 4) legbreaks <- sapply(legbreaks, signif, 4) - # Run cluster method using - hcrow <- stats::hclust(stats::dist(dat), method = gene_clustering_method) - # hc <- stats::hclust(stats::dist(t(dat)), method = smpl_clustering_method) + # Build distance matrices explicitly before hclust() so user-selected + # distance metrics are used. Calling stats::dist(dat) directly would force + # Euclidean distance and ignore gene_distance_metric/smpl_distance_metric. + heatmap_dist <- function(x, metric) { + metric <- trimws(metric) + if (identical(metric, "correlation")) { + corr <- stats::cor(t(x), use = "pairwise.complete.obs") + corr[is.na(corr)] <- 0 + return(stats::as.dist(1 - corr)) + } + + return(stats::dist(x, method = metric)) + } - if (FALSE) { - sort_hclust <- function(...) { - return(stats::as.hclust(rev( - dendsort::dendsort(stats::as.dendrogram(...)) - ))) + sort_hclust <- function(hc, reverse = FALSE, rotation_order = NULL) { + dend <- dendsort::dendsort(stats::as.dendrogram(hc)) + if (reverse) { + dend <- rev(dend) } - } else { - sort_hclust <- function(...) { - return(stats::as.hclust(dendsort::dendsort(stats::as.dendrogram(...)))) + if (!is.null(rotation_order) && length(rotation_order) > 0) { + dend <- dendextend::rotate(dend, rotation_order) } + return(stats::as.hclust(dend)) } - # if (clus) { - # colclus <- sort_hclust(hc) - # } else { - # colclus <- FALSE - # } + if (clus2) { + hcrow <- stats::hclust( + heatmap_dist(dat, gene_distance_metric), + method = gene_clustering_method + ) rowclus <- sort_hclust(hcrow) } else { rowclus <- FALSE } + if (clus) { + sample_rotation <- NULL + if (reorder_dendrogram == TRUE) { + sample_rotation <- reorder_dendrogram_order + } + hccol <- stats::hclust( + heatmap_dist(t(dat), smpl_distance_metric), + method = smpl_clustering_method + ) + colclus <- sort_hclust( + hccol, + reverse = TRUE, + rotation_order = sample_rotation + ) + } else { + colclus <- FALSE + } + if (display_smpl_dendrograms) { smpl_treeheight <- 25 } else { @@ -819,32 +763,20 @@ S7::method(plot_expr_heatmap, S7::class_data.frame) <- function( show_rownames = rn, show_colnames = cn, cluster_rows = rowclus, - cluster_cols = clus, - clustering_distance_rows = drows1, - clustering_distance_cols = dcols1, + cluster_cols = colclus, annotation_col = annotation_col, annotation_colors = annot_col, labels_col = labels_col ) - # mat <- t(dat) - callback <- function(hc, mat) { - dend <- rev(dendsort::dendsort(stats::as.dendrogram(hc))) - if (reorder_dendrogram == TRUE) { - dend <- dend |> dendextend::rotate(reorder_dendrogram_order) - } else { - dend <- dend |> dendextend::rotate(c(1:stats::nobs(dend))) - } - return(stats::as.hclust(dend)) - } ### PH: END SET up heatmap function for do.call ## Make Heatmap + # Row and column clustering are handled above by heatmap_dist(), + # stats::hclust(), and sort_hclust(), then passed in via cluster_rows + # and cluster_cols. return(do.call( ComplexHeatmap::pheatmap, - c( - hm.parameters, - list(clustering_callback = callback) - ) + hm.parameters )) } # End doheatmap() function. @@ -1025,25 +957,40 @@ S7::method(plot_expr_heatmap, S7::class_data.frame) <- function( annotation_col <- as.data.frame(unclass(annotation_col)) annotation_col[] <- lapply(annotation_col, factor) x <- length(unlist(lapply(annotation_col, levels))) - if (x > length(group_colors)) { - k <- x - length(group_colors) - more_cols <- get_random_colors(k) - group_colors <- c(group_colors, more_cols) + if (!is.list(color_values) && x > length(color_values)) { + generated_group_colors <- get_colors_vctr( + data.frame(group_color_index = seq_len(x)), + "group_color_index" + ) + more_cols <- unname(generated_group_colors)[seq.int( + length(color_values) + 1, + x + )] + color_values <- c(color_values, more_cols) } rownames(annotation_col) <- annot[[label_colname]] annot_col <- list() - b <- 1 - i <- 1 - while (i <= length(group_columns)) { - cnam <- group_columns[i] - grp <- as.factor(annotation_col[, i]) - c <- b + length(levels(grp)) - 1 - col <- group_colors[b:c] - names(col) <- levels(grp) - assign(cnam, col) - annot_col <- append(annot_col, mget(cnam)) - b <- c + 1 - i <- i + 1 + next_color <- 1 + for (cnam in group_columns) { + group_levels <- stats::na.omit(unique(annot[[cnam]])) + + if (is.list(color_values) && cnam %in% names(color_values)) { + col <- resolve_plot_colors(annot, cnam, color_values[[cnam]]) + } else if ( + !is.null(names(color_values)) && + all(as.character(group_levels) %in% names(color_values)) + ) { + col <- resolve_plot_colors(annot, cnam, color_values) + } else { + color_slice <- color_values[ + next_color:(next_color + length(group_levels) - 1) + ] + col <- resolve_plot_colors(annot, cnam, color_slice) + } + + next_color <- next_color + length(group_levels) + + annot_col[[cnam]] <- col } if (assign_group_colors == TRUE) { diff --git a/code/MOSuite/R/plot_histogram.R b/code/MOSuite/R/plot_histogram.R index 8dd3087..37e62cf 100644 --- a/code/MOSuite/R/plot_histogram.R +++ b/code/MOSuite/R/plot_histogram.R @@ -54,6 +54,13 @@ plot_histogram <- S7::new_generic( #' the counts slot (`moo@counts`). #' @param sub_count_type Used if `moo_counts` is a `multiOmicDataSet` AND if `count_type` is a list, specify the sub #' count type within the list +#' @param group_colname The column from the sample metadata containing the sample group information. This is usually a +#' column showing to which experimental treatments each sample belongs (e.g. WildType, Knockout, Tumor, Normal, +#' Before, After, etc.). +#' @param color_values vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +#' level order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in +#' the metadata column. Defaults to `NULL`; when `NULL`, `mosuite_palette` is used for `data.frame` dispatch and +#' stored colors are used for `multiOmicDataSet` dispatch. #' @examples #' # plot histogram for a counts slot in a multiOmicDataset Object #' moo <- multiOmicDataSet( @@ -75,16 +82,35 @@ S7::method(plot_histogram, multiOmicDataSet) <- function( moo_counts, count_type, sub_count_type = NULL, + group_colname = "Group", + color_values = NULL, ... ) { counts_dat <- extract_counts(moo_counts, count_type, sub_count_type) + color_values <- color_values %||% moo_counts@analyses$colors[[group_colname]] return(plot_histogram( counts_dat, sample_metadata = moo_counts@sample_meta, + group_colname = group_colname, + color_values = color_values, ... )) } +build_histogram_hover_text <- function( + histogram_data, + sample_id_colname, + group_colname = NULL +) { + return(format_hover_text( + histogram_data, + primary_colname = sample_id_colname, + secondary_colname = group_colname, + missing_col_context = "histogram", + require_secondary = FALSE + )) +} + #' Plot histogram for counts dataframe #' #' @rdname plot_histogram.data.frame @@ -107,7 +133,9 @@ S7::method(plot_histogram, multiOmicDataSet) <- function( #' labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the #' column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: #' `NULL` -- `sample_id_colname` will be used.) -#' @param color_values vector of colors as hex values or names recognized by R +#' @param color_values vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +#' level order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in +#' the metadata column. Defaults to `NULL`; when `NULL`, `mosuite_palette` is used. #' @param color_by_group Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by the #' column you select in the "Group Column Used to Color Histogram" parameter (below). Default is FALSE. #' @param set_min_max_for_x_axis whether to override the default for `ggplot2::xlim()` (default: `FALSE`) @@ -116,11 +144,16 @@ S7::method(plot_histogram, multiOmicDataSet) <- function( #' @param x_axis_label text label for the x axis `ggplot2::xlab()` #' @param y_axis_label text label for the y axis `ggplot2::ylab()` #' @param legend_position passed to in `legend.position` `ggplot2::theme()` -#' @param legend_font_size passed to `ggplot2::element_text()` via `ggplot2::theme()` +#' @param legend_font_size passed to `ggplot2::element_text()` via `ggplot2::theme()`. If `NULL`, the size is scaled +#' automatically based on the number and length of legend labels. #' @param number_of_legend_columns passed to `ncol` in `ggplot2::guide_legend()` #' @param interactive_plots set to TRUE to make the plot interactive with `plotly`, allowing you to hover your mouse #' over a point or line to view sample information. The similarity heat map will not display if this toggle is set to #' TRUE. Default is FALSE. +#' @param return_ggplot If `TRUE`, return the ggplot object prepared for interactive hover text before converting it to +#' plotly. Used when callers need to add more ggplot layers first. Default is `FALSE`. +#' @param use_log2_x_axis If `TRUE`, add a display-only pseudocount to plotted values and use a log2 x-axis. Default is +#' `FALSE`. #' @param ... additional arguments (ignored; accepted for compatibility with the moo dispatch) #' @examples #' @@ -153,20 +186,7 @@ S7::method(plot_histogram, S7::class_data.frame) <- function( feature_id_colname = NULL, group_colname = "Group", label_colname = "Label", - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + color_values = NULL, color_by_group = FALSE, set_min_max_for_x_axis = FALSE, minimum_for_x_axis = -1, @@ -174,12 +194,16 @@ S7::method(plot_histogram, S7::class_data.frame) <- function( x_axis_label = "Counts", y_axis_label = "Density", legend_position = "top", - legend_font_size = 10, + legend_font_size = NULL, number_of_legend_columns = 6, interactive_plots = FALSE, + return_ggplot = FALSE, + use_log2_x_axis = FALSE, ... ) { count <- NULL + log2_axis_pseudocount <- 0.5 + color_values <- color_values %||% mosuite_palette counts_dat <- moo_counts if (is.null(sample_id_colname)) { sample_id_colname <- colnames(sample_metadata)[1] @@ -196,50 +220,171 @@ S7::method(plot_histogram, S7::class_data.frame) <- function( ) |> dplyr::left_join(sample_metadata, by = sample_id_colname) + # For log2 histogram axes, add a display-only pseudocount after reshaping. + # The original count table is not modified; this only keeps zeros finite for ggplot's log transform. + if (isTRUE(use_log2_x_axis)) { + df_long <- df_long |> + dplyr::mutate(count = count + log2_axis_pseudocount) + } + + # Match user-supplied x-axis limits to the plotted scale. On the log2 path, + # limits need the same pseudocount offset as the displayed data. if (set_min_max_for_x_axis == TRUE) { - xmin <- minimum_for_x_axis - xmax <- maximum_for_x_axis + if (isTRUE(use_log2_x_axis)) { + xmin <- minimum_for_x_axis + log2_axis_pseudocount + xmax <- maximum_for_x_axis + log2_axis_pseudocount + } else { + xmin <- minimum_for_x_axis + xmax <- maximum_for_x_axis + } } else { xmin <- min(df_long |> dplyr::pull(count)) xmax <- max(df_long |> dplyr::pull(count)) } + # Guard the log2 axis against non-finite or nonpositive limits after the offset. + if (isTRUE(use_log2_x_axis)) { + if (set_min_max_for_x_axis == TRUE) { + xmin <- max(xmin, log2_axis_pseudocount) + } else { + # Automatic log2 histograms should display a raw minimum of 0. + xmin <- log2_axis_pseudocount + } + if (!is.finite(xmax) || xmax <= xmin) { + xmax <- max(xmin, log2_axis_pseudocount) + } + } if (color_by_group == TRUE) { + df_long <- df_long |> + dplyr::filter(!is.na(!!rlang::sym(group_colname))) + color_values <- resolve_plot_colors(df_long, group_colname, color_values) df_long <- df_long |> dplyr::mutate( - !!rlang::sym(group_colname) := as.factor(!!rlang::sym(group_colname)) - ) |> - dplyr::filter(!is.na(group_colname)) - n <- df_long |> - dplyr::pull(group_colname) |> - levels() |> - length() + !!rlang::sym(group_colname) := as.character(!!rlang::sym(group_colname)) + ) + if (isTRUE(interactive_plots)) { + df_long$histogram_hover_text <- build_histogram_hover_text( + df_long, + sample_id_colname, + group_colname + ) + } + histogram_mapping <- ggplot2::aes( + x = count, + group = !!rlang::sym(sample_id_colname) + ) + if (isTRUE(interactive_plots)) { + histogram_mapping <- ggplot2::aes( + x = count, + group = !!rlang::sym(sample_id_colname), + text = histogram_hover_text + ) + } + # The problem here is that static histograms should keep density curves in + # the plot while showing line-style legend keys instead of box-like keys. + # We build geom_density() args as a list so static output can add + # key_glyph, but the interactive ggplotly() path can skip that tweak. + # Passing the legend-key change into ggplotly() made interactive density + # traces misbehave, so we apply it only for non-interactive plots. + density_layer_args <- list( + mapping = ggplot2::aes(colour = !!rlang::sym(group_colname)), + linewidth = 1 + ) + if (!isTRUE(interactive_plots)) { + density_layer_args$key_glyph <- ggplot2::draw_key_path + } # plot Density hist_plot <- df_long |> - ggplot2::ggplot(ggplot2::aes( + ggplot2::ggplot(histogram_mapping) + + do.call(ggplot2::geom_density, density_layer_args) + } else { + color_values <- resolve_plot_colors( + df_long, + sample_id_colname, + color_values + ) + df_long <- df_long |> + dplyr::mutate( + !!rlang::sym(sample_id_colname) := as.character( + !!rlang::sym(sample_id_colname) + ) + ) + if (isTRUE(interactive_plots)) { + df_long$histogram_hover_text <- build_histogram_hover_text( + df_long, + sample_id_colname, + group_colname + ) + } + histogram_mapping <- ggplot2::aes( + x = count, + group = !!rlang::sym(sample_id_colname) + ) + if (isTRUE(interactive_plots)) { + histogram_mapping <- ggplot2::aes( x = count, - group = !!rlang::sym(sample_id_colname) - )) + - ggplot2::geom_density( - ggplot2::aes(colour = !!rlang::sym(group_colname)), - linewidth = 1 + group = !!rlang::sym(sample_id_colname), + text = histogram_hover_text ) - } else { - n <- df_long |> - dplyr::pull(sample_id_colname) |> - unique() |> - length() + } + # Use the same strategy for sample-colored histograms: solve the static + # legend-key problem without changing the interactive density conversion. + # Static output gets line-style legend keys, while interactive output + # avoids the key_glyph change that breaks ggplotly(). + density_layer_args <- list( + mapping = ggplot2::aes(colour = !!rlang::sym(sample_id_colname)), + linewidth = 1 + ) + if (!isTRUE(interactive_plots)) { + density_layer_args$key_glyph <- ggplot2::draw_key_path + } hist_plot <- df_long |> - ggplot2::ggplot(ggplot2::aes( - x = count, - group = !!rlang::sym(sample_id_colname) - )) + - ggplot2::geom_density( - ggplot2::aes(colour = !!rlang::sym(sample_id_colname)), - linewidth = 1 - ) + ggplot2::ggplot(histogram_mapping) + + do.call(ggplot2::geom_density, density_layer_args) + } + + legend_font_size <- get_legend_text_size( + names(color_values), + legend_font_size + ) + + # Keep the plain histogram default unchanged. When requested, use ggplot's log2 + # scale and label ticks back on the original count scale by subtracting the offset. + x_axis_scale <- if (isTRUE(use_log2_x_axis)) { + ggplot2::scale_x_continuous( + transform = "log2", + limits = c(xmin, xmax), + breaks = function(limits) { + # Breaks are chosen on the original count scale, then shifted by the + # display-only pseudocount so they align with the plotted/log2 values. + raw_upper_limit <- max(limits - log2_axis_pseudocount, na.rm = TRUE) + if (!is.finite(raw_upper_limit) || raw_upper_limit <= 0) { + return(log2_axis_pseudocount) + } + max_power <- floor(log2(raw_upper_limit)) + if (max_power < 0) { + raw_breaks <- c(0, raw_upper_limit) + } else { + # Use powers of two, thinning to about eight labels for wide ranges, + # and always include the highest power so the high end is labeled. + step <- max(1, ceiling((max_power + 1) / 8)) + exponents <- unique(c(seq(0, max_power, by = step), max_power)) + raw_breaks <- c(0, 2^exponents) + } + raw_breaks <- raw_breaks[ + raw_breaks >= 0 & raw_breaks <= raw_upper_limit + ] + return(unique(raw_breaks + log2_axis_pseudocount)) + }, + labels = function(x) { + return(scales::label_number(big.mark = "")(x - log2_axis_pseudocount)) + }, + name = x_axis_label + ) + } else { + ggplot2::xlim(xmin, xmax) } hist_plot <- hist_plot + @@ -248,6 +393,7 @@ S7::method(plot_histogram, S7::class_data.frame) <- function( ggplot2::theme_bw() + ggplot2::theme( legend.position = legend_position, + legend.key = ggplot2::element_blank(), legend.text = ggplot2::element_text(size = legend_font_size), legend.title = ggplot2::element_blank(), panel.background = ggplot2::element_blank(), @@ -262,16 +408,30 @@ S7::method(plot_histogram, S7::class_data.frame) <- function( axis.ticks = ggplot2::element_line(linewidth = 1) ) + ggplot2::ggtitle("Frequency Histogram") + - ggplot2::xlim(xmin, xmax) + + x_axis_scale + # scale_linetype_manual(values=rep(c('solid', 'dashed','dotted','twodash'),n)) + - ggplot2::scale_colour_manual(values = color_values[1:n]) + - ggplot2::guides( - linetype = ggplot2::guide_legend(ncol = number_of_legend_columns) - ) + ggplot2::scale_colour_manual(values = color_values) if (isTRUE(interactive_plots)) { - hist_plot <- (hist_plot + ggplot2::theme(legend.position = "none")) |> - plotly::ggplotly(tooltip = c(sample_id_colname)) + if (isTRUE(return_ggplot)) { + return(hist_plot) + } + hist_plot <- hist_plot |> + plotly::ggplotly(tooltip = "text") + } else { + hist_plot <- add_colour_legend_layout( + hist_plot, + labels = names(color_values), + legend_position = legend_position, + ncol = number_of_legend_columns, + legend_text_size = legend_font_size, + guide_override_aes = list( + linetype = 1, + linewidth = 2, + shape = NA, + fill = NA + ) + ) } return(hist_plot) } diff --git a/code/MOSuite/R/plot_pca.R b/code/MOSuite/R/plot_pca.R index d419b80..3e35982 100644 --- a/code/MOSuite/R/plot_pca.R +++ b/code/MOSuite/R/plot_pca.R @@ -29,6 +29,12 @@ #' #' @details #' +#' PCA is sensitive to feature scale. For raw, cleaned, filtered, or CPM-like count data, setting +#' `log_transform = TRUE` compresses high-count features before PCA so ordination is less dominated by abundance +#' differences. Do not enable this for already normalized/log-scale data, such as voom/logCPM `norm` counts or +#' batch-corrected normalized counts, because that would apply a second log transform. The default PCA transform uses +#' the original MOSuite PCA scaling, `log(x + 0.5)`. +#' #' See the low-level function docs for additional arguments #' depending on whether you're plotting 2 or 3 PCs: #' @@ -122,6 +128,27 @@ S7::method(plot_pca, S7::class_data.frame) <- function( ) } +build_pca_hover_text <- function( + pca_data, + sample_id_colname, + group_colname, + label_colname = NULL +) { + label_hover_colname <- if (is.null(label_colname)) { + sample_id_colname + } else { + label_colname + } + + return(format_hover_text( + pca_data, + primary_colname = label_hover_colname, + secondary_colname = group_colname, + missing_col_context = "PCA", + require_secondary = TRUE + )) +} + #' Perform and plot a 2D Principal Components Analysis #' #' @rdname plot_pca_2d @@ -140,32 +167,23 @@ plot_pca_2d <- S7::new_generic( group_colname = "Group", label_colname = "Label", samples_to_rename = NULL, - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + color_values = NULL, principal_components = c(1, 2), legend_position = "top", - point_size = 1, - add_label = TRUE, + point_size = 5, + legend_font_size = NULL, label_font_size = 3, label_offset_x_ = 2, label_offset_y_ = 2, + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", interactive_plots = FALSE, plots_subdir = "pca", plot_filename = "pca_2D.png", print_plots = options::opt("print_plots"), - save_plots = options::opt("save_plots") + save_plots = options::opt("save_plots"), + ... ) { return(S7::S7_dispatch()) } @@ -182,34 +200,26 @@ S7::method(plot_pca_2d, multiOmicDataSet) <- function( group_colname = "Group", label_colname = "Label", samples_to_rename = NULL, - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + color_values = NULL, principal_components = c(1, 2), legend_position = "top", - point_size = 1, - add_label = TRUE, + point_size = 5, + legend_font_size = NULL, label_font_size = 3, label_offset_x_ = 2, label_offset_y_ = 2, + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", interactive_plots = FALSE, plots_subdir = "pca", plot_filename = "pca_2D.png", print_plots = options::opt("print_plots"), - save_plots = options::opt("save_plots") + save_plots = options::opt("save_plots"), + ... ) { counts_dat <- extract_counts(moo_counts, count_type, sub_count_type) + color_values <- color_values %||% moo_counts@analyses$colors[[group_colname]] return(plot_pca_2d( counts_dat, sample_metadata = moo_counts@sample_meta, @@ -222,10 +232,13 @@ S7::method(plot_pca_2d, multiOmicDataSet) <- function( principal_components = principal_components, legend_position = legend_position, point_size = point_size, - add_label = add_label, + legend_font_size = legend_font_size, label_font_size = label_font_size, label_offset_x_ = label_offset_x_, label_offset_y_ = label_offset_y_, + log_transform = log_transform, + log_transform_pseudocount = log_transform_pseudocount, + log_transform_base = log_transform_base, interactive_plots = interactive_plots, plots_subdir = plots_subdir, plot_filename = plot_filename, @@ -252,20 +265,39 @@ S7::method(plot_pca_2d, multiOmicDataSet) <- function( #' @param group_colname The column from the sample metadata containing the sample group information. This is usually a #' column showing to which experimental treatments each sample belongs (e.g. WildType, Knockout, Tumor, Normal, #' Before, After, etc.). -#' @param label_colname The column from the sample metadata containing the sample labels as you wish them to appear in -#' the plots produced by this template. This can be the same Sample Names Column. However, you may desire different -#' labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the -#' column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: -#' `NULL` -- `sample_id_colname` will be used.) +#' @param label_colname The column from the sample metadata containing the sample labels as you wish them to appear on +#' the PCA plot. If `NULL`, no labels are added to PCA points. This can be the same Sample Names Column. However, you +#' may desire different labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In +#' that case, select the column with your preferred Labels here. The selected column should contain unique names for +#' each sample. #' @param samples_to_rename If you do not have a Plot Labels Column in your sample metadata table, you can use this #' parameter to rename samples manually for display on the PCA plot. Use "Add item" to add each additional sample for #' renaming. Use the following format to describe which old name (in your sample metadata table) you want to rename to #' which new name: old_name: new_name -#' @param color_values vector of colors as hex values or names recognized by R +#' @param color_values vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +#' level order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in +#' the metadata column. Defaults to `NULL`; when `NULL`, `mosuite_palette` is used for `data.frame` dispatch and +#' stored colors are used for `multiOmicDataSet` dispatch. #' @param principal_components vector with numbered principal components to plot #' @param legend_position passed to in `legend.position` `ggplot2::theme()` #' @param point_size size for `ggplot2::geom_point()` -#' @param add_label whether to add text labels for the points +#' @param legend_font_size font size for the PCA legend text. If `NULL`, the size is scaled automatically based on the +#' number and length of legend labels. +#' @param count_type the type of counts to use when `moo_counts` is a `multiOmicDataSet`; ignored for data frame input. +#' @param sub_count_type used when `count_type` refers to a list of count matrices; ignored for data frame input. +#' @param label_font_size font size for text labels on the PCA plot. +#' @param label_offset_x_ horizontal offset for text labels on the PCA plot. +#' @param label_offset_y_ vertical offset for text labels on the PCA plot. +#' @param log_transform If `TRUE`, apply `log(x + log_transform_pseudocount, base = log_transform_base)` to sample +#' count columns before PCA. Use this for count-like data such as raw, clean, filt, or CPM-like counts; leave it +#' `FALSE` for already normalized/log-scale or batch-corrected values to avoid double transformation. +#' @param log_transform_pseudocount Pseudocount added before log-transforming counts when `log_transform` is +#' `TRUE`. +#' @param log_transform_base Logarithm base to use when `log_transform` is `TRUE`. Use a numeric value, or `"e"`, +#' `"ln"`, or `"natural"` for natural log. Default is `"ln"` to match the original PCA transform. +#' @param interactive_plots set to TRUE to make the PCA plot interactive with `plotly`. +#' @param plots_subdir subdirectory in `figures/` where PCA plots are saved. +#' @param plot_filename output filename for the PCA plot image. #' #' @return ggplot object #' @@ -283,34 +315,26 @@ S7::method(plot_pca_2d, S7::class_data.frame) <- function( group_colname = "Group", label_colname = "Label", samples_to_rename = NULL, - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + color_values = NULL, principal_components = c(1, 2), legend_position = "top", - point_size = 1, - add_label = TRUE, + point_size = 5, + legend_font_size = NULL, label_font_size = 3, label_offset_x_ = 2, label_offset_y_ = 2, + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", interactive_plots = FALSE, plots_subdir = "pca", plot_filename = "pca_2D.png", print_plots = options::opt("print_plots"), - save_plots = options::opt("save_plots") + save_plots = options::opt("save_plots"), + ... ) { PC <- std.dev <- percent <- cumulative <- NULL + color_values <- color_values %||% mosuite_palette if (length(principal_components) != 2) { stop( glue::glue( @@ -325,6 +349,14 @@ S7::method(plot_pca_2d, S7::class_data.frame) <- function( if (is.null(feature_id_colname)) { feature_id_colname <- colnames(moo_counts)[1] } + if (isTRUE(log_transform)) { + moo_counts <- log_transform_counts( + moo_counts, + feature_id_colname = feature_id_colname, + pseudocount = log_transform_pseudocount, + base = log_transform_base + ) + } # calculate PCA pca_df <- calc_pca( @@ -344,8 +376,19 @@ S7::method(plot_pca_2d, S7::class_data.frame) <- function( names_prefix = "PC", values_from = "value" ) + pca_wide$pca_hover_text <- build_pca_hover_text( + pca_wide, + sample_id_colname, + group_colname, + label_colname + ) prin_comp_x <- principal_components[1] prin_comp_y <- principal_components[2] + color_values <- resolve_plot_colors(pca_wide, group_colname, color_values) + legend_font_size <- get_legend_text_size( + names(color_values), + legend_font_size + ) # plot PCA pca_plot <- pca_wide |> dplyr::mutate( @@ -354,7 +397,7 @@ S7::method(plot_pca_2d, S7::class_data.frame) <- function( ggplot2::ggplot(ggplot2::aes( x = !!rlang::sym(glue::glue("PC{prin_comp_x}")), y = !!rlang::sym(glue::glue("PC{prin_comp_y}")), - text = !!rlang::sym(sample_id_colname) + text = pca_hover_text )) + ggplot2::geom_point( ggplot2::aes(color = !!rlang::sym(group_colname)), @@ -375,14 +418,21 @@ S7::method(plot_pca_2d, S7::class_data.frame) <- function( linewidth = 1 ), axis.ticks = ggplot2::element_line(linewidth = 1), - legend.text = ggplot2::element_text(size = 18) + legend.text = ggplot2::element_text(size = legend_font_size), + aspect.ratio = 1 ) + - ggplot2::coord_fixed(ratio = 1.5) + ggplot2::scale_colour_manual(values = color_values) + ggplot2::xlab(get_pc_percent_lab(pca_df, prin_comp_x)) + ggplot2::ylab(get_pc_percent_lab(pca_df, prin_comp_y)) - if (add_label == TRUE) { + pca_plot <- add_colour_legend_layout( + pca_plot, + labels = names(color_values), + legend_position = legend_position, + legend_text_size = legend_font_size + ) + + if (!is.null(label_colname)) { abort_packages_not_installed("ggrepel") pca_plot <- pca_plot + ggrepel::geom_text_repel( @@ -398,15 +448,27 @@ S7::method(plot_pca_2d, S7::class_data.frame) <- function( } if (isTRUE(interactive_plots)) { pca_plot <- (pca_plot) |> - plotly::ggplotly(tooltip = c(sample_id_colname, group_colname)) + plotly::ggplotly(tooltip = "text") } - print_or_save_plot( - pca_plot, - filename = file.path(plots_subdir, plot_filename), - print_plots = print_plots, - save_plots = save_plots - ) + if (inherits(pca_plot, "ggplot")) { + print_or_save_plot( + pca_plot, + filename = file.path(plots_subdir, plot_filename), + print_plots = print_plots, + save_plots = save_plots, + width = 7, + height = 7, + units = "in" + ) + } else { + print_or_save_plot( + pca_plot, + filename = file.path(plots_subdir, plot_filename), + print_plots = print_plots, + save_plots = save_plots + ) + } return(pca_plot) } @@ -415,6 +477,7 @@ S7::method(plot_pca_2d, S7::class_data.frame) <- function( #' #' @rdname plot_pca_3d #' @aliases plot_pca_3d +#' @param ... additional arguments passed to methods #' @export plot_pca_3d <- S7::new_generic( "plot_pca_3d", @@ -432,25 +495,16 @@ plot_pca_3d <- S7::new_generic( principal_components = c(1, 2, 3), point_size = 8, label_font_size = 24, - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", + color_values = NULL, plot_title = "PCA 3D", plot_filename = "pca_3D.html", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "pca" + plots_subdir = "pca", + ... ) { return(S7::S7_dispatch()) } @@ -470,27 +524,19 @@ S7::method(plot_pca_3d, multiOmicDataSet) <- function( principal_components = c(1, 2, 3), point_size = 8, label_font_size = 24, - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", + color_values = NULL, plot_title = "PCA 3D", plot_filename = "pca_3D.html", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "pca" + plots_subdir = "pca", + ... ) { counts_dat <- extract_counts(moo_counts, count_type, sub_count_type) + color_values <- color_values %||% moo_counts@analyses$colors[[group_colname]] return( plot_pca_3d( counts_dat, @@ -505,6 +551,9 @@ S7::method(plot_pca_3d, multiOmicDataSet) <- function( principal_components = principal_components, point_size = point_size, label_font_size = label_font_size, + log_transform = log_transform, + log_transform_pseudocount = log_transform_pseudocount, + log_transform_base = log_transform_base, color_values = color_values, plot_title = plot_title, plot_filename = plot_filename, @@ -527,7 +576,10 @@ S7::method(plot_pca_3d, multiOmicDataSet) <- function( #' @param group_colname The column from sample metadata containing sample group information. #' @param label_colname The column from sample metadata containing sample labels. #' @param label_font_size font size used for labels in the interactive figure. -#' @param color_values vector of colors as hex values or names recognized by R. +#' @param color_values vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +#' level order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in +#' the metadata column. Defaults to `NULL`; when `NULL`, `mosuite_palette` is used for `data.frame` dispatch and +#' stored colors are used for `multiOmicDataSet` dispatch. #' @param plot_filename output filename when saving plots. #' @param print_plots whether to print plot to the active graphics device. #' @param save_plots whether to save plot to disk. @@ -535,6 +587,13 @@ S7::method(plot_pca_3d, multiOmicDataSet) <- function( #' #' @param principal_components vector with numbered principal components to plot #' @param point_size size for `ggplot2::geom_point()` +#' @param log_transform If `TRUE`, apply `log(x + log_transform_pseudocount, base = log_transform_base)` to sample +#' count columns before PCA. Use this for count-like data such as raw, clean, filt, or CPM-like counts; leave it +#' `FALSE` for already normalized/log-scale or batch-corrected values to avoid double transformation. +#' @param log_transform_pseudocount Pseudocount added before log-transforming counts when `log_transform` is +#' `TRUE`. +#' @param log_transform_base Logarithm base to use when `log_transform` is `TRUE`. Use a numeric value, or `"e"`, +#' `"ln"`, or `"natural"` for natural log. Default is `"ln"` to match the original PCA transform. #' @param plot_title title for the plot #' #' @returns `plotly::plot_ly` figure @@ -555,27 +614,19 @@ S7::method(plot_pca_3d, S7::class_data.frame) <- function( principal_components = c(1, 2, 3), point_size = 8, label_font_size = 24, - color_values = c( - "#5954d6", - "#e1562c", - "#b80058", - "#00c6f8", - "#d163e6", - "#00a76c", - "#ff9287", - "#008cf9", - "#006e00", - "#796880", - "#FFA500", - "#878500" - ), + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", + color_values = NULL, plot_title = "PCA 3D", plot_filename = "pca_3D.html", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "pca" + plots_subdir = "pca", + ... ) { PC <- std.dev <- percent <- cumulative <- NULL + color_values <- color_values %||% mosuite_palette if (length(principal_components) != 3) { stop( glue::glue( @@ -590,6 +641,17 @@ S7::method(plot_pca_3d, S7::class_data.frame) <- function( if (is.null(sample_id_colname)) { sample_id_colname <- colnames(sample_metadata)[1] } + if (is.null(feature_id_colname)) { + feature_id_colname <- colnames(moo_counts)[1] + } + if (isTRUE(log_transform)) { + moo_counts <- log_transform_counts( + moo_counts, + feature_id_colname = feature_id_colname, + pseudocount = log_transform_pseudocount, + base = log_transform_base + ) + } # if (is.null(color_values)) { # color_values <- moo_nidap@analyses[['colors']][['Group']] @@ -610,9 +672,16 @@ S7::method(plot_pca_3d, S7::class_data.frame) <- function( names_prefix = "PC", values_from = "value" ) + pca_wide$pca_hover_text <- build_pca_hover_text( + pca_wide, + sample_id_colname, + group_colname, + label_colname + ) prin_comp_x <- principal_components[1] prin_comp_y <- principal_components[2] prin_comp_z <- principal_components[3] + color_values <- resolve_plot_colors(pca_wide, group_colname, color_values) fig <- plotly::plot_ly( pca_wide, @@ -625,7 +694,7 @@ S7::method(plot_pca_3d, S7::class_data.frame) <- function( mode = "markers", marker = list(size = point_size), hoverinfo = "text", - text = stats::as.formula(paste("~", sample_id_colname)), + text = ~pca_hover_text, size = label_font_size ) @@ -702,6 +771,13 @@ calc_pca <- function( tedf_filt <- tedf[, colSums(is.na(tedf)) != nrow(tedf)] # remove samples with zero variance tedf_var <- tedf_filt[, apply(tedf_filt, 2, var) != 0] + if (ncol(tedf_var) == 0) { + stop( + "No features with non-zero variance remain after filtering. ", + "PCA cannot be computed on an empty or constant matrix. ", + "Check that filter thresholds are appropriate for the number of samples." + ) + } # calculate PCA pca_fit <- stats::prcomp(tedf_var, scale = TRUE) pca_df <- pca_fit |> diff --git a/code/MOSuite/R/plot_read_depth.R b/code/MOSuite/R/plot_read_depth.R index f78d073..afe2018 100644 --- a/code/MOSuite/R/plot_read_depth.R +++ b/code/MOSuite/R/plot_read_depth.R @@ -56,6 +56,12 @@ plot_read_depth <- S7::new_generic( #' @param count_type the type of counts to use. Must be a name in the counts slot (`names(moo@counts)`). #' @param sub_count_type used if `count_type` is a list in the counts slot: specify the sub count type within the list. #' Must be a name in `names(moo@counts[[count_type]])`. +#' @param sample_id_colname column in sample metadata containing sample IDs. +#' @param group_colname sample metadata column used to color bars. Leave blank to use the current single-color bar fill. +#' @param color_values colors used when `group_colname` is supplied. Named vectors are matched to group values; +#' unnamed vectors follow group order and are extended with MOSuite colors when too few colors are supplied. +#' Defaults to `NULL`; when `NULL`, `mosuite_palette` is used for `data.frame` dispatch and stored colors +#' are used for `multiOmicDataSet` dispatch. #' #' @return ggplot barplot #' @@ -78,10 +84,25 @@ S7::method(plot_read_depth, multiOmicDataSet) <- function( moo_counts, count_type, sub_count_type = NULL, + sample_id_colname = NULL, + group_colname = "", + color_values = NULL, ... ) { counts_dat <- extract_counts(moo_counts, count_type, sub_count_type) - return(plot_read_depth(counts_dat, ...)) + color_by_group <- !is.null(group_colname) && trimws(group_colname) != "" + if (!isTRUE(color_by_group)) { + return(plot_read_depth(counts_dat, ...)) + } + color_values <- color_values %||% moo_counts@analyses$colors[[group_colname]] + return(plot_read_depth( + counts_dat, + sample_metadata = moo_counts@sample_meta, + sample_id_colname = sample_id_colname, + group_colname = group_colname, + color_values = color_values, + ... + )) } #' Plot read depth for `data.frame` @@ -90,6 +111,12 @@ S7::method(plot_read_depth, multiOmicDataSet) <- function( #' @aliases plot_read_depth.data.frame #' @usage NULL #' +#' @param sample_metadata sample metadata dataframe, required when `group_colname` is supplied. +#' @param sample_id_colname column in sample metadata containing sample IDs. +#' @param group_colname sample metadata column used to color bars. Leave blank to use the current single-color bar fill. +#' @param color_values colors used when `group_colname` is supplied. Named vectors are matched to group values; +#' unnamed vectors follow group order and are extended with MOSuite colors when too few colors are supplied. +#' Defaults to `NULL`; when `NULL`, `mosuite_palette` is used. #' @param ... additional arguments (ignored; accepted for compatibility with the moo dispatch) #' #' @return ggplot barplot @@ -100,8 +127,16 @@ S7::method(plot_read_depth, multiOmicDataSet) <- function( #' #' @seealso [plot_read_depth()] generic #' @family plotters for counts dataframes -S7::method(plot_read_depth, S7::class_data.frame) <- function(moo_counts, ...) { +S7::method(plot_read_depth, S7::class_data.frame) <- function( + moo_counts, + sample_metadata = NULL, + sample_id_colname = NULL, + group_colname = "", + color_values = NULL, + ... +) { sample_names <- column_sums <- NULL + color_values <- color_values %||% mosuite_palette counts_dat <- moo_counts sum_df <- counts_dat |> dplyr::summarize(dplyr::across(tidyselect::where(is.numeric), sum)) |> @@ -111,12 +146,48 @@ S7::method(plot_read_depth, S7::class_data.frame) <- function(moo_counts, ...) { values_to = "column_sums" ) + color_by_group <- !is.null(group_colname) && trimws(group_colname) != "" + if (color_by_group) { + if (is.null(sample_metadata)) { + stop("sample_metadata is required when group_colname is supplied") + } + if (is.null(sample_id_colname)) { + sample_id_colname <- colnames(sample_metadata)[1] + } + sum_df <- sum_df |> + dplyr::left_join( + sample_metadata, + by = stats::setNames(sample_id_colname, "sample_names") + ) |> + dplyr::filter(!is.na(!!rlang::sym(group_colname))) + color_values <- resolve_plot_colors(sum_df, group_colname, color_values) + sum_df <- sum_df |> + dplyr::mutate( + !!rlang::sym(group_colname) := as.character( + !!rlang::sym(group_colname) + ) + ) + } + # Plotting read_plot <- ggplot2::ggplot( sum_df, ggplot2::aes(x = sample_names, y = column_sums) - ) + - ggplot2::geom_bar(stat = "identity", fill = "blue") + + ) + + if (color_by_group) { + read_plot <- read_plot + + ggplot2::geom_bar( + ggplot2::aes(fill = !!rlang::sym(group_colname)), + stat = "identity" + ) + + ggplot2::scale_fill_manual(values = color_values) + } else { + read_plot <- read_plot + + ggplot2::geom_bar(stat = "identity", fill = "blue") + } + + read_plot <- read_plot + ggplot2::labs( title = "Total Reads per Sample", x = "Samples", diff --git a/code/MOSuite/R/plot_volcano_summary.R b/code/MOSuite/R/plot_volcano_summary.R index 92a50f3..422402e 100644 --- a/code/MOSuite/R/plot_volcano_summary.R +++ b/code/MOSuite/R/plot_volcano_summary.R @@ -501,7 +501,7 @@ S7::method(plot_volcano_summary, S7::class_data.frame) <- function( nudge_x = nudge_x_all, nudge_y = nudge_y_all, size = label_font_size, - segment.size = line_thickness + segment.linewidth = line_thickness ) + ggplot2::xlim(-xmax, xmax) + ggplot2::ylim(0, ymax) + diff --git a/code/MOSuite/R/plots.R b/code/MOSuite/R/plots.R index 1d5770e..81e3ee9 100644 --- a/code/MOSuite/R/plots.R +++ b/code/MOSuite/R/plots.R @@ -39,6 +39,7 @@ print_or_save_plot <- function( gp = grid::gpar(fontsize = 9, col = "grey40") ) } + return(invisible(NULL)) } if (!is.null(caption) && inherits(plot_obj, "ggplot")) { plot_obj <- plot_obj + ggplot2::labs(caption = caption) @@ -77,3 +78,184 @@ print_or_save_plot <- function( } return(invisible(filename)) } + +format_hover_text <- function( + plot_data, + primary_colname, + secondary_colname = NULL, + missing_col_context = "plot", + require_secondary = TRUE +) { + required_cols <- primary_colname + if (isTRUE(require_secondary) && !is.null(secondary_colname)) { + required_cols <- c(required_cols, secondary_colname) + } + + missing_cols <- setdiff(required_cols, colnames(plot_data)) + if (length(missing_cols) > 0) { + stop(glue::glue( + "Missing required {missing_col_context} metadata column(s): {glue::glue_collapse(missing_cols, sep = ", + ")}" + )) + } + + primary_text <- paste0( + primary_colname, + ": ", + plot_data[[primary_colname]] + ) + + if ( + is.null(secondary_colname) || !secondary_colname %in% colnames(plot_data) + ) { + return(primary_text) + } + + return(paste0( + primary_text, + "
", + secondary_colname, + ": ", + plot_data[[secondary_colname]] + )) +} + +#' Compute a wrapped colour legend column count +#' +#' Computes a conservative number of legend columns for horizontal ggplot colour +#' legends. Top and bottom legends are wrapped based on the number of labels and +#' the longest label length. Other legend positions return `NULL` so their +#' existing ggplot layout is preserved. +#' +#' @param labels Character vector of legend labels. +#' @param legend_position Legend position passed to `ggplot2::theme()`. +#' @param ncol Optional maximum number of legend columns. +#' @param legend_text_size Legend text size used to scale the horizontal space +#' estimate. Larger legend text uses fewer columns. +#' @param max_label_characters_per_row Approximate total label characters to fit +#' on one horizontal legend row. +#' +#' @return Integer column count for top/bottom legends, or `NULL` when no +#' wrapping should be applied. +#' @keywords internal +#' @noRd +get_legend_column_count <- function( + labels, + legend_position = "top", + ncol = NULL, + legend_text_size = 10, + max_label_characters_per_row = 45 +) { + if (!legend_position %in% c("top", "bottom")) { + return(NULL) + } + + labels <- stats::na.omit(as.character(labels)) + if (length(labels) == 0) { + return(NULL) + } + + max_label_length <- max(nchar(labels), 1) + text_size_multiplier <- legend_text_size / 10 + columns_by_label_length <- max( + 1, + floor( + max_label_characters_per_row / (max_label_length * text_size_multiplier) + ) + ) + legend_columns <- min(length(labels), columns_by_label_length) + if (!is.null(ncol)) { + legend_columns <- min(ncol, legend_columns) + } + return(legend_columns) +} + +#' Compute colour legend text size +#' +#' Computes legend text size from legend labels. Short legends keep the larger +#' default text used by simple group legends, while longer or denser legends are +#' scaled down. +#' +#' @param labels Character vector of legend labels. +#' @param legend_text_size Optional explicit legend text size. When supplied, +#' this value is returned unchanged. +#' @param min_legend_text_size Smallest automatically selected legend text size. +#' @param max_legend_text_size Largest automatically selected legend text size. +#' +#' @return Numeric legend text size. +#' @keywords internal +#' @noRd +get_legend_text_size <- function( + labels, + legend_text_size = NULL, + min_legend_text_size = 8, + max_legend_text_size = 18 +) { + if (!is.null(legend_text_size)) { + return(legend_text_size) + } + + labels <- stats::na.omit(as.character(labels)) + if (length(labels) == 0) { + return(max_legend_text_size) + } + + label_pressure <- max( + max(nchar(labels), 1) / 5, + length(labels) / 4, + 1 + ) + + return(max( + min_legend_text_size, + floor(max_legend_text_size / sqrt(label_pressure)) + )) +} + +#' Add wrapped colour legend layout to a ggplot +#' +#' Applies a colour guide with a wrapped column count for top and bottom legends. +#' Left, right, and hidden legends are returned unchanged. +#' +#' @param plot A `ggplot2` plot object. +#' @inheritParams get_legend_column_count +#' +#' @return A `ggplot2` plot object with colour legend layout applied when needed. +#' @keywords internal +#' @noRd +add_colour_legend_layout <- function( + plot, + labels, + legend_position = "top", + ncol = NULL, + legend_text_size = 10, + max_label_characters_per_row = 45, + guide_override_aes = NULL +) { + legend_columns <- get_legend_column_count( + labels = labels, + legend_position = legend_position, + ncol = ncol, + legend_text_size = legend_text_size, + max_label_characters_per_row = max_label_characters_per_row + ) + + if (is.null(legend_columns)) { + return(plot) + } + + guide_args <- list(ncol = legend_columns, byrow = TRUE) + if (!is.null(guide_override_aes)) { + guide_args$override.aes <- guide_override_aes + } + + return( + plot + + ggplot2::guides( + colour = do.call(ggplot2::guide_legend, guide_args) + ) + + ggplot2::theme( + legend.box = "vertical" + ) + ) +} diff --git a/code/MOSuite/R/reexports.R b/code/MOSuite/R/reexports.R index c7c32ad..f586a0a 100644 --- a/code/MOSuite/R/reexports.R +++ b/code/MOSuite/R/reexports.R @@ -13,6 +13,11 @@ rlang::`!!` #' @export rlang::.data +#' default for null values +#' @importFrom rlang %||% +#' @export +rlang::`%||%` + # Suppress R CMD check note 'All declared Imports should be used'. # These are used in S7 methods. #' @importFrom dendextend rotate diff --git a/code/MOSuite/R/render_report.R b/code/MOSuite/R/render_report.R new file mode 100644 index 0000000..2a4d686 --- /dev/null +++ b/code/MOSuite/R/render_report.R @@ -0,0 +1,64 @@ +#' Render the template report +#' +#' Copy the Quarto template to the current working directory and render it +#' using `quarto::quarto_render()`. The rendered report will be saved in the +#' current working directory. You can specify additional arguments to +#' `quarto::quarto_render()` to customize the rendering process. +#' +#' You can edit the copy of `report.qmd` in the current working directory to customize the report. +#' +#' @param qmd_template Path to the Quarto report file (default is the template report in the package). +#' @param qmd_src Optional path to copy the Quarto report template to before +#' rendering. If `NULL` (default), the template will be copied to the current +#' working directory with the same filename as the template. If a file already +#' exists at `qmd_src`, it will not be overwritten. +#' @param ... Additional arguments passed to `quarto::quarto_render()`, such as +#' `execute_params` (a named list of parameters) or `quarto_args` (a +#' character vector of CLI flags, e.g. `c("--output-dir", "/path/to/out")`). +#' +#' @export +#' +#' @examples +#' render_report(execute_params = list( +#' counts_csv = system.file("extdata", "nidap", "Raw_Counts.csv.gz", +#' package = "MOSuite"), +#' samplesheet_csv = system.file("extdata", "nidap", +#' "Sample_Metadata_Bulk_RNA-seq_Training_Dataset_CCBR.csv.gz", +#' package = "MOSuite") +#' )) +#' +#' # Render to a specific output directory +#' render_report( +#' quarto_args = c("--output-dir", "./results"), +#' execute_params = list( +#' counts_csv = system.file("extdata", "nidap", "Raw_Counts.csv.gz", +#' package = "MOSuite"), +#' samplesheet_csv = system.file("extdata", "nidap", +#' "Sample_Metadata_Bulk_RNA-seq_Training_Dataset_CCBR.csv.gz", +#' package = "MOSuite") +#' ) +#' ) +render_report <- function( + qmd_template = system.file("quarto", "report.qmd", package = "MOSuite"), + qmd_src = NULL, + ... +) { + abort_packages_not_installed(c("quarto", "knitr", "rmarkdown")) # nolint: object_usage_linter + if (is.null(qmd_src)) { + qmd_src <- basename(qmd_template) + } + # Resolve to absolute path so quarto subprocess uses the correct directory + qmd_src <- normalizePath(qmd_src, mustWork = FALSE) + if (!file.exists(qmd_src)) { + ok <- file.copy(qmd_template, qmd_src, overwrite = FALSE) + if (!isTRUE(ok)) { + stop(glue::glue( + "Failed to copy template from '{qmd_template}' to '{qmd_src}'" + )) + } + } + return(quarto::quarto_render( + input = qmd_src, + ... + )) +} diff --git a/code/MOSuite/SECURITY.md b/code/MOSuite/SECURITY.md new file mode 100644 index 0000000..99da43f --- /dev/null +++ b/code/MOSuite/SECURITY.md @@ -0,0 +1,18 @@ +# NCI Standard Public Repository Security Policy + +## Maintained Versions + +Actively maintained versions of contained software will vary from repository to repository, or may not be relevant at all. +The developers of this repository will update this section if any actively maintained versions of the software need to be publicly disclosed. Otherwise, contact the developers directly for any version information. + +## Vulnerability Disclosure: + +### Option 1: HHS Vulnerability Disclosure + +Follow the instructions listed in the [HHS vulnerability disclosure policy](https://www.hhs.gov/vulnerability-disclosure-policy/index.html). + +### Option 2: Private Vulnerability Report + +1. Click on the **Security and quality** tab of this repository. +2. Locate the **Report a vulnerability** button. If the button is not on the **Security and quality** landing page, look under the **Advisories** section in the side bar. +3. Click the **Report a vulnerability** button and submit the form. The developers will receive a notification of your submission. diff --git a/code/MOSuite/_pkgdown.yml b/code/MOSuite/_pkgdown.yml index 504949b..72a89c4 100644 --- a/code/MOSuite/_pkgdown.yml +++ b/code/MOSuite/_pkgdown.yml @@ -53,9 +53,9 @@ reference: - title: Visualization contents: - has_keyword("plotters") -- subtitle: Color selectors - contents: - contains("color") + - contains("palette") + - render_report - title: Misc. helpers & utilities contents: - starts_with('calc_') diff --git a/code/MOSuite/codemeta.json b/code/MOSuite/codemeta.json index 5cf8660..165fcf8 100644 --- a/code/MOSuite/codemeta.json +++ b/code/MOSuite/codemeta.json @@ -32,5 +32,5 @@ "license": "https://spdx.org/licenses/MIT", "name": "MOSuite: R package for differential multi-omics analysis", "url": "https://ccbr.github.io/MOSuite/", - "version": "0.3.1.9001" + "version": "0.3.2.9000" } diff --git a/code/MOSuite/data-raw/mosuite_palette.R b/code/MOSuite/data-raw/mosuite_palette.R new file mode 100644 index 0000000..402fd4e --- /dev/null +++ b/code/MOSuite/data-raw/mosuite_palette.R @@ -0,0 +1,26 @@ +mosuite_palette <- c( + "#5954d6", + "#e1562c", + "#b80058", + "#00c6f8", + "#d163e6", + "#00a76c", + "#ff9287", + "#008cf9", + "#006e00", + "#796880", + "#FFA500", + "#878500" +) + +usethis::use_data(mosuite_palette, overwrite = TRUE) + +ggplot2::ggsave( + filename = "mosuite_palette.png", + plot = display_palette(mosuite_palette), + path = "man/figures", + width = 7, + height = 2, + units = "in", + dpi = 300 +) diff --git a/code/MOSuite/data/mosuite_palette.rda b/code/MOSuite/data/mosuite_palette.rda new file mode 100644 index 0000000000000000000000000000000000000000..ab1004ba4962e614aa0f7bbeb7a3fca233b0bcd1 GIT binary patch literal 174 zcmV;f08#%!T4*^jL0KkKSsZ(N4FCXae}Mk9zyJsWf8Zqm7C^ry&Hw-bAOMmWGGPIx zfEqM3&@{+0AxDaOjik`pj6i4rIT-bL2Qp(*MW{#-r6}p;Js8!h5JC*dC_+t00gO;V z<3%G8jAHi+!Pgp~jRja%RE*LM;t2by5; + clean_raw_counts() |> + filter_counts(group_colname = group_colname) |> + normalize_counts(group_colname = group_colname) |> + batch_correct_counts( + covariates_colname = group_colname, + batch_colname = batch_colname, + label_colname = label_colname + ) |> + diff_counts( + count_type = "filt", + covariates_colnames = c(group_colname, batch_colname), + contrast_colname = c(group_colname), + contrasts = contrasts_vctr, + input_in_log_counts = FALSE, + return_mean_and_sd = FALSE, + voom_normalization_method = "quantile", + ) |> + filter_diff() + +moo@analyses$diff |> + join_dfs_wide() |> + head() |> + kable() + +moo@analyses$diff_filt |> head() |> kable() +``` + +## Visualization + +### 3D PCA + +```{r pca_3D} +plot_pca( + moo@counts$batch, + moo@sample_meta, + principal_components = c(1, 2, 3), + group_colname = group_colname, + label_colname = label_colname, + color_values = moo@analyses[["colors"]][[group_colname]] +) +``` + +### Expression Heatmap + +```{r expr_heatmap} +heatmap_plot <- plot_expr_heatmap( + moo, + count_type = "norm", + sub_count_type = "voom" +) +print(heatmap_plot) +``` + +### Volcano + +#### Summary + +```{r volcano_summary} +dat_volcano_summary <- moo@analyses$diff |> + join_dfs_wide() |> + plot_volcano_summary() + +head(dat_volcano_summary) +``` + +#### Enhanced + +```{r volcano_enhanced} +dat_volcano_enhanced <- moo@analyses$diff |> + join_dfs_wide() |> + plot_volcano_enhanced() +``` + + +### Venn Diagram + +```{r venn_diagram} +venn_dat <- dat_volcano_summary |> plot_venn_diagram() +head(venn_dat) +``` diff --git a/code/MOSuite/man/batch_correct_counts.Rd b/code/MOSuite/man/batch_correct_counts.Rd index 9be8aa8..67a22c6 100644 --- a/code/MOSuite/man/batch_correct_counts.Rd +++ b/code/MOSuite/man/batch_correct_counts.Rd @@ -13,10 +13,28 @@ batch_correct_counts( samples_to_include = NULL, covariates_colnames = "Group", batch_colname = "Batch", - label_colname = NULL, + label_colname = "Label", + samples_to_rename = c(""), + add_label_to_pca = TRUE, + principal_component_on_x_axis = 1, + principal_component_on_y_axis = 2, + legend_position_for_pca = "top", + label_offset_x_ = 2, + label_offset_y_ = 2, + label_font_size = 3, + point_size_for_pca = 5, + color_histogram_by_group = TRUE, + set_min_max_for_x_axis_for_histogram = FALSE, + minimum_for_x_axis_for_histogram = -1, + maximum_for_x_axis_for_histogram = 1, + legend_font_size_for_histogram = NULL, + legend_position_for_histogram = "top", + number_of_histogram_legend_columns = 6, + plot_corr_matrix_heatmap = TRUE, colors_for_plots = NULL, print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), + interactive_plots = FALSE, plots_subdir = "batch" ) } @@ -54,18 +72,73 @@ If your data set has no batches, you can provide a batch column with the same value in every row to skip batch correction (alternatively, simply do not run this function).} \item{label_colname}{The column from the sample metadata containing the sample labels as you wish them to appear in -the plots produced by this template. This can be the same Sample Names Column. However, you may desire different -labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the -column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: -\code{NULL} -- \code{sample_id_colname} will be used.)} +heatmap and PCA figures. This can be the same Sample Names Column. However, you may desire different labels to +display on your figures (e.g. shorter labels are sometimes preferred on plots). In that case, select the column with +your preferred Labels here. The selected column should contain unique names for each sample. Use \code{add_label_to_pca} +to control whether these labels are displayed on the PCA plot.} -\item{colors_for_plots}{Colors for the PCA and histogram will be picked, in order, from this list. -Colors must either be names in \code{grDevices::colors()} or valid hex codes.} +\item{samples_to_rename}{If you do not have a Plot Labels Column in your sample metadata table, you can use this +parameter to rename samples manually for display on the PCA plot. Use "Add item" to add each additional sample for +renaming. Use the following format to describe which old name (in your sample metadata table) you want to rename to +which new name: old_name: new_name} + +\item{add_label_to_pca}{If \code{TRUE}, display labels from \code{label_colname} on PCA points. If \code{FALSE}, the PCA plot uses +unlabeled points while heatmap labels still use \code{label_colname}.} + +\item{principal_component_on_x_axis}{The principal component to plot on the x-axis for the PCA plot. Choices include +1, 2, 3, ... (default: 1)} + +\item{principal_component_on_y_axis}{The principal component to plot on the y-axis for the PCA plot. Choices include +1, 2, 3, ... (default: 2)} + +\item{legend_position_for_pca}{legend position for the PCA plot} + +\item{label_offset_x_}{label offset x for the PCA plot} + +\item{label_offset_y_}{label offset y for the PCA plot} + +\item{label_font_size}{label font size for the PCA plot} + +\item{point_size_for_pca}{geom point size for the PCA plot} + +\item{color_histogram_by_group}{Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by +the column you select in the "Group Column Used to Color Histogram" parameter (below). Default is TRUE.} + +\item{set_min_max_for_x_axis_for_histogram}{whether to set min/max value for histogram x-axis} + +\item{minimum_for_x_axis_for_histogram}{x-axis minimum for histogram plot} + +\item{maximum_for_x_axis_for_histogram}{x-axis maximum for histogram plot} + +\item{legend_font_size_for_histogram}{legend font size for the histogram plot. +If \code{NULL}, the size is scaled automatically.} + +\item{legend_position_for_histogram}{legend position for the histogram plot. consider setting to 'none' for a large +number of samples.} + +\item{number_of_histogram_legend_columns}{number of columns for the histogram legend} + +\item{plot_corr_matrix_heatmap}{Datasets with a large number of samples may be too large to create a correlation +matrix heatmap. If this function takes longer than 5 minutes to run, Set to \code{FALSE} and the correlation matrix will +not be be created. Default is \code{TRUE}.} + +\item{colors_for_plots}{Optional colors for PCA/histogram/heatmap plots. If \code{NULL}, colors are taken from +\code{moo@analyses$colors[[group_colname]]}. +Colors must either be names in \code{grDevices::colors()} or valid hex codes. +Unnamed colors are assigned by factor level order when the grouping column is a factor; +otherwise, they follow the order in which groups first appear in the metadata column. If more groups are present +than colors provided, +supplied colors are used first and additional colors are generated from the selected palette for the remaining +groups; random colors are used only if that palette returns fewer colors than the number of groups.} \item{print_plots}{Whether to print plots during analysis (Defaults to \code{FALSE}, overwritable using option 'moo_print_plots' or environment variable 'MOO_PRINT_PLOTS')} \item{save_plots}{Whether to save plots to files during analysis (Defaults to \code{TRUE}, overwritable using option 'moo_save_plots' or environment variable 'MOO_SAVE_PLOTS')} +\item{interactive_plots}{set to TRUE to make PCA and Histogram plots interactive with \code{plotly}, allowing you to hover +your mouse over a point or line to view sample information. The similarity heat map will not display if this toggle +is set to \code{TRUE}. Default is \code{FALSE}.} + \item{plots_subdir}{subdirectory in \verb{figures/} where plots will be saved if \code{save_plots} is \code{TRUE}} } \value{ diff --git a/code/MOSuite/man/clean_raw_counts.Rd b/code/MOSuite/man/clean_raw_counts.Rd index f4f580d..2d48ded 100644 --- a/code/MOSuite/man/clean_raw_counts.Rd +++ b/code/MOSuite/man/clean_raw_counts.Rd @@ -10,6 +10,8 @@ clean_raw_counts( sample_id_colname = NULL, feature_id_colname = NULL, samples_to_rename = "", + group_colname = "", + colors_for_plots = NULL, cleanup_column_names = TRUE, split_gene_name = TRUE, aggregate_rows_with_duplicate_gene_names = TRUE, @@ -38,6 +40,14 @@ parameter to rename samples manually for display on the PCA plot. Use "Add item" renaming. Use the following format to describe which old name (in your sample metadata table) you want to rename to which new name: old_name: new_name} +\item{group_colname}{sample metadata column used to color the read-depth plot. Leave blank to use the current +single-color bar fill.} + +\item{colors_for_plots}{optional colors used when \code{group_colname} is supplied. If \code{NULL}, colors are taken from +\code{moo@analyses$colors[[group_colname]]}. +Named vectors are matched to group values; +unnamed vectors follow group order and are extended with MOSuite colors when too few colors are supplied.} + \item{cleanup_column_names}{Invalid raw counts column names can cause errors in the downstream analysis. If this is \code{TRUE}, any invalid column names will be automatically altered to a correct format. These format changes diff --git a/code/MOSuite/man/diff_counts.Rd b/code/MOSuite/man/diff_counts.Rd index bf72697..e1a48c4 100644 --- a/code/MOSuite/man/diff_counts.Rd +++ b/code/MOSuite/man/diff_counts.Rd @@ -65,7 +65,7 @@ contrast(s)} \item{plots_subdir}{subdirectory in \verb{figures/} where plots will be saved if \code{save_plots} is \code{TRUE}} } \value{ -\code{multiOmicDataSet} with \code{diff} added to the \code{analyses} slot (i.e. \code{moo@analyses$diff}) +\code{multiOmicDataSet} with \code{diff} added to the \code{analyses} slot (i.e. \code{moo@analyses[["diff"]]}) } \description{ Differential expression analysis diff --git a/code/MOSuite/man/display_colors.Rd b/code/MOSuite/man/display_colors.Rd new file mode 100644 index 0000000..0512f5a --- /dev/null +++ b/code/MOSuite/man/display_colors.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/colors.R +\name{display_colors} +\alias{display_colors} +\title{Display colors for a multiOmicDataSet object} +\usage{ +display_colors(moo) +} +\arguments{ +\item{moo}{A \code{multiOmicDataSet} object (see +\code{\link[=create_multiOmicDataSet_from_dataframes]{create_multiOmicDataSet_from_dataframes()}}).} +} +\value{ +A \link[patchwork:wrap_plots]{patchwork} of \link[ggplot2:ggplot]{ggplot2::ggplot} objects, +one per group column in \code{moo@analyses$colors}. +} +\description{ +Plots a palette strip for each group column stored in \code{moo@analyses$colors}, +stacked vertically. Each strip shows the assigned hex colors and their codes. +} +\examples{ +moo <- create_multiOmicDataSet_from_dataframes(nidap_sample_metadata, nidap_raw_counts) +display_colors(moo) +} diff --git a/code/MOSuite/man/display_palette.Rd b/code/MOSuite/man/display_palette.Rd new file mode 100644 index 0000000..dbc63a4 --- /dev/null +++ b/code/MOSuite/man/display_palette.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/colors.R +\name{display_palette} +\alias{display_palette} +\title{Display the mosuite color palette} +\usage{ +display_palette(palette = mosuite_palette) +} +\arguments{ +\item{palette}{Character vector of hex color codes. Defaults to +\code{mosuite_palette}.} +} +\value{ +Invisibly returns the underlying \link[ggplot2:ggplot]{ggplot2::ggplot} object. +} +\description{ +Plots each color in \code{mosuite_palette} as a labeled tile with its hex code +displayed below. The plot is rendered at a width proportional to the number +of colors so labels remain horizontal and legible. +} +\examples{ +display_palette() +display_palette(c("#FF0000", "#00FF00", "#0000FF")) +} diff --git a/code/MOSuite/man/filter_counts.Rd b/code/MOSuite/man/filter_counts.Rd index 984545b..ce1e67d 100644 --- a/code/MOSuite/man/filter_counts.Rd +++ b/code/MOSuite/man/filter_counts.Rd @@ -10,7 +10,7 @@ filter_counts( feature_id_colname = NULL, sample_id_colname = NULL, group_colname = "Group", - label_colname = NULL, + label_colname = "Label", samples_to_include = NULL, minimum_count_value_to_be_considered_nonzero = 8, minimum_number_of_samples_with_nonzero_counts_in_total = 7, @@ -20,18 +20,18 @@ filter_counts( principal_component_on_x_axis = 1, principal_component_on_y_axis = 2, legend_position_for_pca = "top", - point_size_for_pca = 1, + point_size_for_pca = 5, add_label_to_pca = TRUE, label_font_size = 3, label_offset_y_ = 2, label_offset_x_ = 2, samples_to_rename = c(""), - color_histogram_by_group = FALSE, + color_histogram_by_group = TRUE, set_min_max_for_x_axis_for_histogram = FALSE, minimum_for_x_axis_for_histogram = -1, maximum_for_x_axis_for_histogram = 1, legend_position_for_histogram = "top", - legend_font_size_for_histogram = 10, + legend_font_size_for_histogram = NULL, number_of_histogram_legend_columns = 6, colors_for_plots = NULL, plot_corr_matrix_heatmap = TRUE, @@ -60,21 +60,24 @@ column showing to which experimental treatments each sample belongs (e.g. WildTy Before, After, etc.).} \item{label_colname}{The column from the sample metadata containing the sample labels as you wish them to appear in -the plots produced by this template. This can be the same Sample Names Column. However, you may desire different -labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the -column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: -\code{NULL} -- \code{sample_id_colname} will be used.)} +heatmap and PCA figures. This can be the same Sample Names Column. However, you may desire different labels to +display on your figures (e.g. shorter labels are sometimes preferred on plots). In that case, select the column with +your preferred Labels here. The selected column should contain unique names for each sample. Use \code{add_label_to_pca} +to control whether these labels are displayed on the PCA plot.} \item{samples_to_include}{Which samples would you like to include? Usually, you will choose all sample columns, or you could choose to remove certain samples. Samples excluded here will be removed in this step and from further analysis downstream of this step. (Default: \code{NULL} - all sample IDs in \code{moo@sample_meta} will be used.)} -\item{minimum_count_value_to_be_considered_nonzero}{Minimum count value to be considered non-zero for a sample} +\item{minimum_count_value_to_be_considered_nonzero}{Minimum value in the selected filtering table required for a +sample to be considered nonzero. If \code{use_cpm_counts_to_filter} is \code{TRUE}, this threshold is applied to CPM values. +If \code{use_cpm_counts_to_filter} is \code{FALSE}, this threshold is applied directly to the selected \code{count_type} table.} -\item{minimum_number_of_samples_with_nonzero_counts_in_total}{Minimum number of samples (total) with non-zero counts} +\item{minimum_number_of_samples_with_nonzero_counts_in_total}{Minimum number of samples in total that must meet the +\code{minimum_count_value_to_be_considered_nonzero} threshold for a feature to be kept.} \item{minimum_number_of_samples_with_nonzero_counts_in_a_group}{Only keeps genes that have at least this number of -samples with nonzero CPM counts in at least one group} +samples meeting the threshold in at least one group} \item{use_cpm_counts_to_filter}{If no transformation has been been performed on counts matrix (eg Raw Counts) set to TRUE. If TRUE counts will be transformed to CPM and filtered based on given criteria. If gene counts matrix has @@ -83,7 +86,7 @@ transformation will be applied and features will be filtered as is. For RNAseq d transformed to CPM in order to properly filter.} \item{use_group_based_filtering}{If TRUE, only keeps features (e.g. genes) that have at least a certain number of -samples with nonzero CPM counts in at least one group} +samples passing the threshold in at least one group} \item{principal_component_on_x_axis}{The principal component to plot on the x-axis for the PCA plot. Choices include 1, 2, 3, ... (default: 1)} @@ -95,7 +98,8 @@ samples with nonzero CPM counts in at least one group} \item{point_size_for_pca}{geom point size for the PCA plot} -\item{add_label_to_pca}{label points on the PCA plot} +\item{add_label_to_pca}{If \code{TRUE}, display labels from \code{label_colname} on PCA points. If \code{FALSE}, the PCA plot uses +unlabeled points while heatmap labels still use \code{label_colname}.} \item{label_font_size}{label font size for the PCA plot} @@ -109,7 +113,7 @@ renaming. Use the following format to describe which old name (in your sample me which new name: old_name: new_name} \item{color_histogram_by_group}{Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by -the column you select in the "Group Column Used to Color Histogram" parameter (below). Default is FALSE.} +the column you select in the "Group Column Used to Color Histogram" parameter (below). Default is TRUE.} \item{set_min_max_for_x_axis_for_histogram}{whether to set min/max value for histogram x-axis} @@ -120,12 +124,19 @@ the column you select in the "Group Column Used to Color Histogram" parameter (b \item{legend_position_for_histogram}{legend position for the histogram plot. consider setting to 'none' for a large number of samples.} -\item{legend_font_size_for_histogram}{legend font size for the histogram plot} +\item{legend_font_size_for_histogram}{legend font size for the histogram plot. +If \code{NULL}, the size is scaled automatically.} \item{number_of_histogram_legend_columns}{number of columns for the histogram legend} -\item{colors_for_plots}{Colors for the PCA and histogram will be picked, in order, from this list. -Colors must either be names in \code{grDevices::colors()} or valid hex codes.} +\item{colors_for_plots}{Optional colors for PCA/histogram/heatmap plots. If \code{NULL}, colors are taken from +\code{moo@analyses$colors[[group_colname]]}. +Colors must either be names in \code{grDevices::colors()} or valid hex codes. +Unnamed colors are assigned by factor level order when the grouping column is a factor; +otherwise, they follow the order in which groups first appear in the metadata column. If more groups are present +than colors provided, +supplied colors are used first and additional colors are generated from the selected palette for the remaining +groups; random colors are used only if that palette returns fewer colors than the number of groups.} \item{plot_corr_matrix_heatmap}{Datasets with a large number of samples may be too large to create a correlation matrix heatmap. If this function takes longer than 5 minutes to run, Set to \code{FALSE} and the correlation matrix will diff --git a/code/MOSuite/man/get_colors_lst.Rd b/code/MOSuite/man/get_colors_lst.Rd index fbe22fa..7cb6fed 100644 --- a/code/MOSuite/man/get_colors_lst.Rd +++ b/code/MOSuite/man/get_colors_lst.Rd @@ -4,26 +4,23 @@ \alias{get_colors_lst} \title{Create named list of default colors for plotting} \usage{ -get_colors_lst(sample_metadata, palette_fun = grDevices::palette.colors, ...) +get_colors_lst(sample_metadata, palette = mosuite_palette) } \arguments{ \item{sample_metadata}{sample metadata as a data frame or tibble. The first column is assumed to contain the sample IDs which must correspond to column names in the raw counts.} -\item{palette_fun}{Function for selecting colors. Assumed to contain \code{n} for the number of colors. Default: -\code{grDevices::palette.colors()}} - -\item{...}{additional arguments forwarded to \code{palette_fun}} +\item{palette}{Character vector of colors to assign. Defaults to +\code{mosuite_palette}.} } \value{ -named list, with each column in \code{sample_metadata} containing entry with a named vector of colors +named list, with each column in \code{sample_metadata} containing a corresponding entry with a named vector of +colors } \description{ Create named list of default colors for plotting } \examples{ get_colors_lst(nidap_sample_metadata) -\dontrun{ -get_colors_lst(nidap_sample_metadata, palette_fun = RColorBrewer::brewer.pal, name = "Set3") -} +get_colors_lst(nidap_sample_metadata, palette = RColorBrewer::brewer.pal(12, "Set3")) } diff --git a/code/MOSuite/man/get_colors_vctr.Rd b/code/MOSuite/man/get_colors_vctr.Rd index adef32e..0155194 100644 --- a/code/MOSuite/man/get_colors_vctr.Rd +++ b/code/MOSuite/man/get_colors_vctr.Rd @@ -4,21 +4,31 @@ \alias{get_colors_vctr} \title{Get vector of colors for observations in one column of a data frame} \usage{ -get_colors_vctr(dat, colname, palette_fun = grDevices::palette.colors, ...) +get_colors_vctr(dat, colname, palette = mosuite_palette, color_offset = 0L) } \arguments{ \item{dat}{data frame} \item{colname}{column name in \code{dat}} -\item{palette_fun}{Function for selecting colors. Assumed to contain \code{n} for the number of colors. Default: -\code{grDevices::palette.colors()}} +\item{palette}{Character vector of colors to assign. Defaults to +\code{mosuite_palette}.} -\item{...}{additional arguments forwarded to \code{palette_fun}} +\item{color_offset}{integer; number of palette colors to skip before +assigning colors to this column's values. Used by \code{\link[=get_colors_lst]{get_colors_lst()}} to +avoid repeating colors across columns with few unique values.} } \value{ -named vector of colors for each unique observation in \code{dat$colname} +Named character vector of hex colors, one per unique observed value +in \code{dat[[colname]]}. } \description{ -Get vector of colors for observations in one column of a data frame +Assigns one color per unique observed value in \code{dat[[colname]]}, drawn from +\code{palette} starting at \code{color_offset}. If the palette is too short, +falls back to \code{get_random_colors()}. Factor columns use factor-level order; +other columns use first-observed order. +} +\examples{ +get_colors_vctr(nidap_sample_metadata, "Group") +get_colors_vctr(nidap_sample_metadata, "Group", color_offset = 3L) } diff --git a/code/MOSuite/man/get_observed_values.Rd b/code/MOSuite/man/get_observed_values.Rd new file mode 100644 index 0000000..d16e087 --- /dev/null +++ b/code/MOSuite/man/get_observed_values.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/colors.R +\name{get_observed_values} +\alias{get_observed_values} +\title{Get observed values from a column} +\usage{ +get_observed_values(dat, colname) +} +\arguments{ +\item{dat}{data frame} + +\item{colname}{column name in \code{dat}} +} +\value{ +character vector of observed values +} +\description{ +Returns non-missing values from \code{dat[[colname]]}. For factor columns, values +are returned in factor-level order; otherwise, values keep first-observed +order. +} +\keyword{internal} diff --git a/code/MOSuite/man/get_random_colors.Rd b/code/MOSuite/man/get_random_colors.Rd index 3b6fd5a..213985b 100644 --- a/code/MOSuite/man/get_random_colors.Rd +++ b/code/MOSuite/man/get_random_colors.Rd @@ -15,8 +15,9 @@ get_random_colors(num_colors, n = 2000) vector of random colors in hex format. } \description{ -Note: this function is not guaranteed to create a color blind friendly palette. -Consider using other palettes such as \code{RColorBrewer::display.brewer.all(colorblindFriendly = TRUE)}. +Note: this function is not guaranteed to create a color blind friendly +palette. Consider using other palettes such as +\code{RColorBrewer::display.brewer.all(colorblindFriendly = TRUE)}. } \examples{ \dontrun{ diff --git a/code/MOSuite/man/log_transform_counts.Rd b/code/MOSuite/man/log_transform_counts.Rd new file mode 100644 index 0000000..33b9007 --- /dev/null +++ b/code/MOSuite/man/log_transform_counts.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/counts.R +\name{log_transform_counts} +\alias{log_transform_counts} +\title{Log-transform count columns in a data frame} +\usage{ +log_transform_counts( + counts_dat, + feature_id_colname = NULL, + sample_colnames = NULL, + pseudocount = 0.5, + base = "ln" +) +} +\arguments{ +\item{counts_dat}{data frame of feature counts.} + +\item{feature_id_colname}{name of the column in \code{counts_dat} that contains feature/gene IDs. (Default: \code{NULL} - first +column in the count data will be used.)} + +\item{sample_colnames}{optional vector of sample columns to transform. If \code{NULL}, all columns except +\code{feature_id_colname} are transformed.} + +\item{pseudocount}{value added before log transformation.} + +\item{base}{logarithm base to use for the transformation. Use a numeric value, or \code{"e"}, \code{"ln"}, or \code{"natural"} +for natural log. Default is \code{"ln"}.} +} +\value{ +count data frame with selected count columns transformed as \code{log(x + pseudocount, base)}. +} +\description{ +Log-transform count columns in a data frame +} +\keyword{internal} diff --git a/code/MOSuite/man/mosuite_palette.Rd b/code/MOSuite/man/mosuite_palette.Rd new file mode 100644 index 0000000..a3ea87b --- /dev/null +++ b/code/MOSuite/man/mosuite_palette.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{mosuite_palette} +\alias{mosuite_palette} +\title{Default MOSuite color palette} +\format{ +A character vector of length 12. +} +\usage{ +mosuite_palette +} +\description{ +A character vector of 12 hex color codes used as the default palette throughout MOSuite plots. +Colors are assigned to groups in the order they appear (or by factor level order). +Use \code{\link[=set_color_pal]{set_color_pal()}} to override the palette for a specific metadata column. +} +\examples{ +mosuite_palette +scales::show_col(mosuite_palette) +} +\seealso{ +\code{\link[=select_mosuite_colors]{select_mosuite_colors()}}, \code{\link[=set_color_pal]{set_color_pal()}} +} +\keyword{data} diff --git a/code/MOSuite/man/normalize_counts.Rd b/code/MOSuite/man/normalize_counts.Rd index 0bfd0ea..b4c362a 100644 --- a/code/MOSuite/man/normalize_counts.Rd +++ b/code/MOSuite/man/normalize_counts.Rd @@ -12,7 +12,7 @@ normalize_counts( samples_to_include = NULL, sample_id_colname = NULL, group_colname = "Group", - label_colname = NULL, + label_colname = "Label", input_in_log_counts = FALSE, voom_normalization_method = "quantile", samples_to_rename = c(""), @@ -23,12 +23,12 @@ normalize_counts( label_offset_x_ = 2, label_offset_y_ = 2, label_font_size = 3, - point_size_for_pca = 8, + point_size_for_pca = 5, color_histogram_by_group = TRUE, set_min_max_for_x_axis_for_histogram = FALSE, minimum_for_x_axis_for_histogram = -1, maximum_for_x_axis_for_histogram = 1, - legend_font_size_for_histogram = 10, + legend_font_size_for_histogram = NULL, legend_position_for_histogram = "top", number_of_histogram_legend_columns = 6, plot_corr_matrix_heatmap = TRUE, @@ -64,10 +64,10 @@ column showing to which experimental treatments each sample belongs (e.g. WildTy Before, After, etc.).} \item{label_colname}{The column from the sample metadata containing the sample labels as you wish them to appear in -the plots produced by this template. This can be the same Sample Names Column. However, you may desire different -labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the -column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: -\code{NULL} -- \code{sample_id_colname} will be used.)} +heatmap and PCA figures. This can be the same Sample Names Column. However, you may desire different labels to +display on your figures (e.g. shorter labels are sometimes preferred on plots). In that case, select the column with +your preferred Labels here. The selected column should contain unique names for each sample. Use \code{add_label_to_pca} +to control whether these labels are displayed on the PCA plot.} \item{input_in_log_counts}{set this to \code{TRUE} if counts are already log2-transformed} @@ -78,7 +78,8 @@ parameter to rename samples manually for display on the PCA plot. Use "Add item" renaming. Use the following format to describe which old name (in your sample metadata table) you want to rename to which new name: old_name: new_name} -\item{add_label_to_pca}{label points on the PCA plot} +\item{add_label_to_pca}{If \code{TRUE}, display labels from \code{label_colname} on PCA points. If \code{FALSE}, the PCA plot uses +unlabeled points while heatmap labels still use \code{label_colname}.} \item{principal_component_on_x_axis}{The principal component to plot on the x-axis for the PCA plot. Choices include 1, 2, 3, ... (default: 1)} @@ -97,7 +98,7 @@ which new name: old_name: new_name} \item{point_size_for_pca}{geom point size for the PCA plot} \item{color_histogram_by_group}{Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by -the column you select in the "Group Column Used to Color Histogram" parameter (below). Default is FALSE.} +the column you select in the "Group Column Used to Color Histogram" parameter (below). Default is TRUE.} \item{set_min_max_for_x_axis_for_histogram}{whether to set min/max value for histogram x-axis} @@ -105,7 +106,8 @@ the column you select in the "Group Column Used to Color Histogram" parameter (b \item{maximum_for_x_axis_for_histogram}{x-axis maximum for histogram plot} -\item{legend_font_size_for_histogram}{legend font size for the histogram plot} +\item{legend_font_size_for_histogram}{legend font size for the histogram plot. +If \code{NULL}, the size is scaled automatically.} \item{legend_position_for_histogram}{legend position for the histogram plot. consider setting to 'none' for a large number of samples.} @@ -116,8 +118,14 @@ number of samples.} matrix heatmap. If this function takes longer than 5 minutes to run, Set to \code{FALSE} and the correlation matrix will not be be created. Default is \code{TRUE}.} -\item{colors_for_plots}{Colors for the PCA and histogram will be picked, in order, from this list. -Colors must either be names in \code{grDevices::colors()} or valid hex codes.} +\item{colors_for_plots}{Optional colors for PCA/histogram/heatmap plots. If \code{NULL}, colors are taken from +\code{moo@analyses$colors[[group_colname]]}. +Colors must either be names in \code{grDevices::colors()} or valid hex codes. +Unnamed colors are assigned by factor level order when the grouping column is a factor; +otherwise, they follow the order in which groups first appear in the metadata column. If more groups are present +than colors provided, +supplied colors are used first and additional colors are generated from the selected palette for the remaining +groups; random colors are used only if that palette returns fewer colors than the number of groups.} \item{print_plots}{Whether to print plots during analysis (Defaults to \code{FALSE}, overwritable using option 'moo_print_plots' or environment variable 'MOO_PRINT_PLOTS')} diff --git a/code/MOSuite/man/plot_corr_heatmap-data.frame.Rd b/code/MOSuite/man/plot_corr_heatmap-data.frame.Rd index 0eec133..f027f0c 100644 --- a/code/MOSuite/man/plot_corr_heatmap-data.frame.Rd +++ b/code/MOSuite/man/plot_corr_heatmap-data.frame.Rd @@ -28,7 +28,9 @@ labels to display on your figure (e.g. shorter labels are sometimes preferred on column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: \code{NULL} -- \code{sample_id_colname} will be used.)} -\item{color_values}{vector of colors as hex values or names recognized by R} +\item{color_values}{vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +level order when the grouping column is a factor; otherwise, they are assigned in the order groups first appear in +the metadata column. Defaults to \code{NULL}; when \code{NULL}, \code{mosuite_palette} is used.} } \description{ Plot correlation heatmap for counts dataframe diff --git a/code/MOSuite/man/plot_corr_heatmap-multiOmicDataSet.Rd b/code/MOSuite/man/plot_corr_heatmap-multiOmicDataSet.Rd index 0f09035..6aa3754 100644 --- a/code/MOSuite/man/plot_corr_heatmap-multiOmicDataSet.Rd +++ b/code/MOSuite/man/plot_corr_heatmap-multiOmicDataSet.Rd @@ -12,6 +12,15 @@ \item{sub_count_type}{used if \code{count_type} is a list in the counts slot: specify the sub count type within the list. Must be a name in \code{names(moo@counts[[count_type]])}.} +\item{group_colname}{The column from the sample metadata containing the sample group information. This is usually a +column showing to which experimental treatments each sample belongs (e.g. WildType, Knockout, Tumor, Normal, +Before, After, etc.).} + +\item{color_values}{vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +level order when the grouping column is a factor; otherwise, they are assigned in the order groups first appear in +the metadata column. Defaults to \code{NULL}; when \code{NULL}, \code{mosuite_palette} is used for \code{data.frame} dispatch and +stored colors are used for \code{multiOmicDataSet} dispatch.} + \item{...}{additional arguments forwarded to \code{\link[=plot_corr_heatmap]{plot_corr_heatmap()}} for \code{data.frame}} } \description{ diff --git a/code/MOSuite/man/plot_corr_heatmap.Rd b/code/MOSuite/man/plot_corr_heatmap.Rd index f09d191..9649791 100644 --- a/code/MOSuite/man/plot_corr_heatmap.Rd +++ b/code/MOSuite/man/plot_corr_heatmap.Rd @@ -34,10 +34,7 @@ plot_corr_heatmap(moo_counts, feature_id_colname = NULL, group_colname = "Group", label_colname = "Label", - color_values = c( - "#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500" - )) + color_values = mosuite_palette) }\if{html}{\out{}} } } diff --git a/code/MOSuite/man/plot_expr_heatmap.Rd b/code/MOSuite/man/plot_expr_heatmap.Rd index 8f8b890..e4458b5 100644 --- a/code/MOSuite/man/plot_expr_heatmap.Rd +++ b/code/MOSuite/man/plot_expr_heatmap.Rd @@ -16,8 +16,7 @@ plot_expr_heatmap( group_colname = "Group", label_colname = NULL, samples_to_include = NULL, - color_values = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), + color_values = NULL, include_all_genes = FALSE, filter_top_genes_by_variance = TRUE, top_genes_by_variance_to_include = 500, @@ -42,8 +41,6 @@ plot_expr_heatmap( group_columns = c("Group", "Replicate", "Batch"), assign_group_colors = FALSE, assign_color_to_sample_groups = c(), - group_colors = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), heatmap_color_scheme = "Default", autoscale_heatmap_color = TRUE, set_min_heatmap_color = -2, @@ -56,7 +53,8 @@ plot_expr_heatmap( plot_filename = "expr_heatmap.png", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "heatmap" + plots_subdir = "heatmap", + ... ) ## S7 method for class @@ -70,8 +68,7 @@ plot_expr_heatmap( group_colname = "Group", label_colname = NULL, samples_to_include = NULL, - color_values = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), + color_values = NULL, include_all_genes = FALSE, filter_top_genes_by_variance = TRUE, top_genes_by_variance_to_include = 500, @@ -96,8 +93,6 @@ plot_expr_heatmap( group_columns = c("Group", "Replicate", "Batch"), assign_group_colors = FALSE, assign_color_to_sample_groups = c(), - group_colors = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), heatmap_color_scheme = "Default", autoscale_heatmap_color = TRUE, set_min_heatmap_color = -2, @@ -110,7 +105,8 @@ plot_expr_heatmap( plot_filename = "expr_heatmap.png", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "heatmap" + plots_subdir = "heatmap", + ... ) ## S7 method for class @@ -124,8 +120,7 @@ plot_expr_heatmap( group_colname = "Group", label_colname = NULL, samples_to_include = NULL, - color_values = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), + color_values = NULL, include_all_genes = FALSE, filter_top_genes_by_variance = TRUE, top_genes_by_variance_to_include = 500, @@ -150,8 +145,6 @@ plot_expr_heatmap( group_columns = c("Group", "Replicate", "Batch"), assign_group_colors = FALSE, assign_color_to_sample_groups = c(), - group_colors = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), heatmap_color_scheme = "Default", autoscale_heatmap_color = TRUE, set_min_heatmap_color = -2, @@ -164,7 +157,8 @@ plot_expr_heatmap( plot_filename = "expr_heatmap.png", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "heatmap" + plots_subdir = "heatmap", + ... ) } \arguments{ @@ -201,7 +195,10 @@ column with your preferred Labels here. The selected column should contain uniqu you could choose to remove certain samples. Samples excluded here will be removed in this step and from further analysis downstream of this step. (Default: \code{NULL} - all sample IDs in \code{moo@sample_meta} will be used.)} -\item{color_values}{vector of colors as hex values or names recognized by R} +\item{color_values}{vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +level order when the grouping column is a factor; otherwise, they are assigned in the order groups first appear in +the metadata column. Defaults to \code{NULL}; when \code{NULL}, \code{mosuite_palette} is used for \code{data.frame} dispatch and +stored colors are used for \code{multiOmicDataSet} dispatch.} \item{include_all_genes}{Set to TRUE if all genes are to be included. Set to FALSE if you want to filter genes by variance and/or provide a list of specific genes that will appear in the heatmap.} @@ -263,8 +260,6 @@ sample names.} \item{assign_color_to_sample_groups}{Enter each sample to color in the format: group_name: color This parameter is ignored if "Assign Colors" is set to FALSE.} -\item{group_colors}{Set group annotation colors.} - \item{heatmap_color_scheme}{color scheme (TODO document options)} \item{autoscale_heatmap_color}{Set to TRUE to autoscale the heatmap colors between the maximum and minimum heatmap @@ -296,6 +291,8 @@ you want to see these numbers on the plot.} \item{save_plots}{Whether to save plots to files during analysis (Defaults to \code{TRUE}, overwritable using option 'moo_save_plots' or environment variable 'MOO_SAVE_PLOTS')} \item{plots_subdir}{subdirectory in \verb{figures/} where plots will be saved if \code{save_plots} is \code{TRUE}} + +\item{...}{additional arguments passed to methods} } \value{ heatmap from \code{ComplexHeatmap::Heatmap()} diff --git a/code/MOSuite/man/plot_histogram.data.frame.Rd b/code/MOSuite/man/plot_histogram.data.frame.Rd index ba46275..1f94792 100644 --- a/code/MOSuite/man/plot_histogram.data.frame.Rd +++ b/code/MOSuite/man/plot_histogram.data.frame.Rd @@ -26,7 +26,9 @@ labels to display on your figure (e.g. shorter labels are sometimes preferred on column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: \code{NULL} -- \code{sample_id_colname} will be used.)} -\item{color_values}{vector of colors as hex values or names recognized by R} +\item{color_values}{vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +level order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in +the metadata column. Defaults to \code{NULL}; when \code{NULL}, \code{mosuite_palette} is used.} \item{color_by_group}{Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by the column you select in the "Group Column Used to Color Histogram" parameter (below). Default is FALSE.} @@ -43,7 +45,8 @@ column you select in the "Group Column Used to Color Histogram" parameter (below \item{legend_position}{passed to in \code{legend.position} \code{ggplot2::theme()}} -\item{legend_font_size}{passed to \code{ggplot2::element_text()} via \code{ggplot2::theme()}} +\item{legend_font_size}{passed to \code{ggplot2::element_text()} via \code{ggplot2::theme()}. If \code{NULL}, the size is scaled +automatically based on the number and length of legend labels.} \item{number_of_legend_columns}{passed to \code{ncol} in \code{ggplot2::guide_legend()}} @@ -51,6 +54,12 @@ column you select in the "Group Column Used to Color Histogram" parameter (below over a point or line to view sample information. The similarity heat map will not display if this toggle is set to TRUE. Default is FALSE.} +\item{return_ggplot}{If \code{TRUE}, return the ggplot object prepared for interactive hover text before converting it to +plotly. Used when callers need to add more ggplot layers first. Default is \code{FALSE}.} + +\item{use_log2_x_axis}{If \code{TRUE}, add a display-only pseudocount to plotted values and use a log2 x-axis. Default is +\code{FALSE}.} + \item{...}{additional arguments (ignored; accepted for compatibility with the moo dispatch)} } \description{ diff --git a/code/MOSuite/man/plot_histogram.multiOmicDataSet.Rd b/code/MOSuite/man/plot_histogram.multiOmicDataSet.Rd index 75da66e..4b47fe4 100644 --- a/code/MOSuite/man/plot_histogram.multiOmicDataSet.Rd +++ b/code/MOSuite/man/plot_histogram.multiOmicDataSet.Rd @@ -10,6 +10,15 @@ the counts slot (\code{moo@counts}).} \item{sub_count_type}{Used if \code{moo_counts} is a \code{multiOmicDataSet} AND if \code{count_type} is a list, specify the sub count type within the list} + +\item{group_colname}{The column from the sample metadata containing the sample group information. This is usually a +column showing to which experimental treatments each sample belongs (e.g. WildType, Knockout, Tumor, Normal, +Before, After, etc.).} + +\item{color_values}{vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +level order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in +the metadata column. Defaults to \code{NULL}; when \code{NULL}, \code{mosuite_palette} is used for \code{data.frame} dispatch and +stored colors are used for \code{multiOmicDataSet} dispatch.} } \description{ Plot histogram for multiOmicDataSet diff --git a/code/MOSuite/man/plot_palette.Rd b/code/MOSuite/man/plot_palette.Rd new file mode 100644 index 0000000..31bddf5 --- /dev/null +++ b/code/MOSuite/man/plot_palette.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/colors.R +\name{plot_palette} +\alias{plot_palette} +\title{Plot a palette tile strip} +\usage{ +plot_palette(dat) +} +\arguments{ +\item{dat}{data frame with columns \code{hex} (hex color codes) and \code{idx} +(factor, used for faceting)} +} +\value{ +a \link[ggplot2:ggplot]{ggplot2::ggplot} object +} +\description{ +Renders a data frame with columns \code{hex} and \code{idx} as a row of colored tiles, +each labeled with its hex code. Used internally by \code{\link[=display_palette]{display_palette()}} and +\code{\link[=display_colors]{display_colors()}}. +} +\keyword{internal} diff --git a/code/MOSuite/man/plot_pca.Rd b/code/MOSuite/man/plot_pca.Rd index 6dfa47e..5fa6b6e 100644 --- a/code/MOSuite/man/plot_pca.Rd +++ b/code/MOSuite/man/plot_pca.Rd @@ -22,6 +22,12 @@ PCA plot (2D or 3D depending on the number of \code{principal_components}) Perform and plot a Principal Components Analysis } \details{ +PCA is sensitive to feature scale. For raw, cleaned, filtered, or CPM-like count data, setting +\code{log_transform = TRUE} compresses high-count features before PCA so ordination is less dominated by abundance +differences. Do not enable this for already normalized/log-scale data, such as voom/logCPM \code{norm} counts or +batch-corrected normalized counts, because that would apply a second log transform. The default PCA transform uses +the original MOSuite PCA scaling, \code{log(x + 0.5)}. + See the low-level function docs for additional arguments depending on whether you're plotting 2 or 3 PCs: \itemize{ diff --git a/code/MOSuite/man/plot_pca_2d.Rd b/code/MOSuite/man/plot_pca_2d.Rd index 244d8b2..32b343c 100644 --- a/code/MOSuite/man/plot_pca_2d.Rd +++ b/code/MOSuite/man/plot_pca_2d.Rd @@ -16,20 +16,23 @@ plot_pca_2d( group_colname = "Group", label_colname = "Label", samples_to_rename = NULL, - color_values = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), + color_values = NULL, principal_components = c(1, 2), legend_position = "top", - point_size = 1, - add_label = TRUE, + point_size = 5, + legend_font_size = NULL, label_font_size = 3, label_offset_x_ = 2, label_offset_y_ = 2, + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", interactive_plots = FALSE, plots_subdir = "pca", plot_filename = "pca_2D.png", print_plots = options::opt("print_plots"), - save_plots = options::opt("save_plots") + save_plots = options::opt("save_plots"), + ... ) ## S7 method for class @@ -43,20 +46,23 @@ plot_pca_2d( group_colname = "Group", label_colname = "Label", samples_to_rename = NULL, - color_values = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), + color_values = NULL, principal_components = c(1, 2), legend_position = "top", - point_size = 1, - add_label = TRUE, + point_size = 5, + legend_font_size = NULL, label_font_size = 3, label_offset_x_ = 2, label_offset_y_ = 2, + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", interactive_plots = FALSE, plots_subdir = "pca", plot_filename = "pca_2D.png", print_plots = options::opt("print_plots"), - save_plots = options::opt("save_plots") + save_plots = options::opt("save_plots"), + ... ) ## S7 method for class @@ -70,30 +76,32 @@ plot_pca_2d( group_colname = "Group", label_colname = "Label", samples_to_rename = NULL, - color_values = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), + color_values = NULL, principal_components = c(1, 2), legend_position = "top", - point_size = 1, - add_label = TRUE, + point_size = 5, + legend_font_size = NULL, label_font_size = 3, label_offset_x_ = 2, label_offset_y_ = 2, + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", interactive_plots = FALSE, plots_subdir = "pca", plot_filename = "pca_2D.png", print_plots = options::opt("print_plots"), - save_plots = options::opt("save_plots") + save_plots = options::opt("save_plots"), + ... ) } \arguments{ \item{moo_counts}{counts dataframe or \code{multiOmicDataSet} containing \code{count_type} & \code{sub_count_type} in the counts slot} -\item{count_type}{type to assign the values of \code{counts_dat} to in the \code{counts} slot} +\item{count_type}{the type of counts to use when \code{moo_counts} is a \code{multiOmicDataSet}; ignored for data frame input.} -\item{sub_count_type}{used if \code{count_type} is a list in the counts slot: specify the sub count type within the list. -Must be a name in \code{names(moo@counts[[count_type]])}.} +\item{sub_count_type}{used when \code{count_type} refers to a list of count matrices; ignored for data frame input.} \item{sample_metadata}{sample metadata as a data frame or tibble.} @@ -110,18 +118,21 @@ used.)} column showing to which experimental treatments each sample belongs (e.g. WildType, Knockout, Tumor, Normal, Before, After, etc.).} -\item{label_colname}{The column from the sample metadata containing the sample labels as you wish them to appear in -the plots produced by this template. This can be the same Sample Names Column. However, you may desire different -labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the -column with your preferred Labels here. The selected column should contain unique names for each sample. (Default: -\code{NULL} -- \code{sample_id_colname} will be used.)} +\item{label_colname}{The column from the sample metadata containing the sample labels as you wish them to appear on +the PCA plot. If \code{NULL}, no labels are added to PCA points. This can be the same Sample Names Column. However, you +may desire different labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In +that case, select the column with your preferred Labels here. The selected column should contain unique names for +each sample.} \item{samples_to_rename}{If you do not have a Plot Labels Column in your sample metadata table, you can use this parameter to rename samples manually for display on the PCA plot. Use "Add item" to add each additional sample for renaming. Use the following format to describe which old name (in your sample metadata table) you want to rename to which new name: old_name: new_name} -\item{color_values}{vector of colors as hex values or names recognized by R} +\item{color_values}{vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +level order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in +the metadata column. Defaults to \code{NULL}; when \code{NULL}, \code{mosuite_palette} is used for \code{data.frame} dispatch and +stored colors are used for \code{multiOmicDataSet} dispatch.} \item{principal_components}{vector with numbered principal components to plot} @@ -129,25 +140,36 @@ which new name: old_name: new_name} \item{point_size}{size for \code{ggplot2::geom_point()}} -\item{add_label}{whether to add text labels for the points} +\item{legend_font_size}{font size for the PCA legend text. If \code{NULL}, the size is scaled automatically based on the +number and length of legend labels.} -\item{label_font_size}{label font size for the PCA plot} +\item{label_font_size}{font size for text labels on the PCA plot.} -\item{label_offset_x_}{label offset x for the PCA plot} +\item{label_offset_x_}{horizontal offset for text labels on the PCA plot.} -\item{label_offset_y_}{label offset y for the PCA plot} +\item{label_offset_y_}{vertical offset for text labels on the PCA plot.} -\item{interactive_plots}{set to TRUE to make PCA and Histogram plots interactive with \code{plotly}, allowing you to hover -your mouse over a point or line to view sample information. The similarity heat map will not display if this toggle -is set to \code{TRUE}. Default is \code{FALSE}.} +\item{log_transform}{If \code{TRUE}, apply \code{log(x + log_transform_pseudocount, base = log_transform_base)} to sample +count columns before PCA. Use this for count-like data such as raw, clean, filt, or CPM-like counts; leave it +\code{FALSE} for already normalized/log-scale or batch-corrected values to avoid double transformation.} -\item{plots_subdir}{subdirectory in \verb{figures/} where plots will be saved if \code{save_plots} is \code{TRUE}} +\item{log_transform_pseudocount}{Pseudocount added before log-transforming counts when \code{log_transform} is +\code{TRUE}.} -\item{plot_filename}{plot output filename - only used if save_plots is TRUE} +\item{log_transform_base}{Logarithm base to use when \code{log_transform} is \code{TRUE}. Use a numeric value, or \code{"e"}, +\code{"ln"}, or \code{"natural"} for natural log. Default is \code{"ln"} to match the original PCA transform.} + +\item{interactive_plots}{set to TRUE to make the PCA plot interactive with \code{plotly}.} + +\item{plots_subdir}{subdirectory in \verb{figures/} where PCA plots are saved.} + +\item{plot_filename}{output filename for the PCA plot image.} \item{print_plots}{Whether to print plots during analysis (Defaults to \code{FALSE}, overwritable using option 'moo_print_plots' or environment variable 'MOO_PRINT_PLOTS')} \item{save_plots}{Whether to save plots to files during analysis (Defaults to \code{TRUE}, overwritable using option 'moo_save_plots' or environment variable 'MOO_SAVE_PLOTS')} + +\item{...}{arguments forwarded to method} } \value{ ggplot object diff --git a/code/MOSuite/man/plot_pca_3d.Rd b/code/MOSuite/man/plot_pca_3d.Rd index acf569d..1dcc939 100644 --- a/code/MOSuite/man/plot_pca_3d.Rd +++ b/code/MOSuite/man/plot_pca_3d.Rd @@ -19,13 +19,16 @@ plot_pca_3d( principal_components = c(1, 2, 3), point_size = 8, label_font_size = 24, - color_values = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", + color_values = NULL, plot_title = "PCA 3D", plot_filename = "pca_3D.html", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "pca" + plots_subdir = "pca", + ... ) ## S7 method for class @@ -42,13 +45,16 @@ plot_pca_3d( principal_components = c(1, 2, 3), point_size = 8, label_font_size = 24, - color_values = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", + color_values = NULL, plot_title = "PCA 3D", plot_filename = "pca_3D.html", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "pca" + plots_subdir = "pca", + ... ) ## S7 method for class @@ -65,13 +71,16 @@ plot_pca_3d( principal_components = c(1, 2, 3), point_size = 8, label_font_size = 24, - color_values = c("#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", - "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"), + log_transform = FALSE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", + color_values = NULL, plot_title = "PCA 3D", plot_filename = "pca_3D.html", print_plots = options::opt("print_plots"), save_plots = options::opt("save_plots"), - plots_subdir = "pca" + plots_subdir = "pca", + ... ) } \arguments{ @@ -99,7 +108,20 @@ plot_pca_3d( \item{label_font_size}{font size used for labels in the interactive figure.} -\item{color_values}{vector of colors as hex values or names recognized by R.} +\item{log_transform}{If \code{TRUE}, apply \code{log(x + log_transform_pseudocount, base = log_transform_base)} to sample +count columns before PCA. Use this for count-like data such as raw, clean, filt, or CPM-like counts; leave it +\code{FALSE} for already normalized/log-scale or batch-corrected values to avoid double transformation.} + +\item{log_transform_pseudocount}{Pseudocount added before log-transforming counts when \code{log_transform} is +\code{TRUE}.} + +\item{log_transform_base}{Logarithm base to use when \code{log_transform} is \code{TRUE}. Use a numeric value, or \code{"e"}, +\code{"ln"}, or \code{"natural"} for natural log. Default is \code{"ln"} to match the original PCA transform.} + +\item{color_values}{vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor +level order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in +the metadata column. Defaults to \code{NULL}; when \code{NULL}, \code{mosuite_palette} is used for \code{data.frame} dispatch and +stored colors are used for \code{multiOmicDataSet} dispatch.} \item{plot_title}{title for the plot} @@ -110,6 +132,8 @@ plot_pca_3d( \item{save_plots}{whether to save plot to disk.} \item{plots_subdir}{output subdirectory for saved plots.} + +\item{...}{additional arguments passed to methods} } \value{ \code{plotly::plot_ly} figure diff --git a/code/MOSuite/man/plot_read_depth.data.frame.Rd b/code/MOSuite/man/plot_read_depth.data.frame.Rd index 35c2689..dc490a8 100644 --- a/code/MOSuite/man/plot_read_depth.data.frame.Rd +++ b/code/MOSuite/man/plot_read_depth.data.frame.Rd @@ -5,6 +5,16 @@ \alias{plot_read_depth.data.frame} \title{Plot read depth for \code{data.frame}} \arguments{ +\item{sample_metadata}{sample metadata dataframe, required when \code{group_colname} is supplied.} + +\item{sample_id_colname}{column in sample metadata containing sample IDs.} + +\item{group_colname}{sample metadata column used to color bars. Leave blank to use the current single-color bar fill.} + +\item{color_values}{colors used when \code{group_colname} is supplied. Named vectors are matched to group values; +unnamed vectors follow group order and are extended with MOSuite colors when too few colors are supplied. +Defaults to \code{NULL}; when \code{NULL}, \code{mosuite_palette} is used.} + \item{...}{additional arguments (ignored; accepted for compatibility with the moo dispatch)} } \value{ diff --git a/code/MOSuite/man/plot_read_depth.multiOmicDataSet.Rd b/code/MOSuite/man/plot_read_depth.multiOmicDataSet.Rd index 50647ec..250c402 100644 --- a/code/MOSuite/man/plot_read_depth.multiOmicDataSet.Rd +++ b/code/MOSuite/man/plot_read_depth.multiOmicDataSet.Rd @@ -9,6 +9,15 @@ \item{sub_count_type}{used if \code{count_type} is a list in the counts slot: specify the sub count type within the list. Must be a name in \code{names(moo@counts[[count_type]])}.} + +\item{sample_id_colname}{column in sample metadata containing sample IDs.} + +\item{group_colname}{sample metadata column used to color bars. Leave blank to use the current single-color bar fill.} + +\item{color_values}{colors used when \code{group_colname} is supplied. Named vectors are matched to group values; +unnamed vectors follow group order and are extended with MOSuite colors when too few colors are supplied. +Defaults to \code{NULL}; when \code{NULL}, \code{mosuite_palette} is used for \code{data.frame} dispatch and stored colors +are used for \code{multiOmicDataSet} dispatch.} } \value{ ggplot barplot diff --git a/code/MOSuite/man/reexports.Rd b/code/MOSuite/man/reexports.Rd index 41acbe5..b16c098 100644 --- a/code/MOSuite/man/reexports.Rd +++ b/code/MOSuite/man/reexports.Rd @@ -6,6 +6,7 @@ \alias{:=} \alias{!!} \alias{.data} +\alias{\%||\%} \title{walrus operator} \keyword{internal} \description{ @@ -13,6 +14,6 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ - \item{rlang}{\code{\link[rlang::=]{:=()}}, \code{\link[rlang:!!]{!!()}}, \code{\link[rlang:.data]{.data}}} + \item{rlang}{\code{\link[rlang::=]{:=()}}, \code{\link[rlang:!!]{!!()}}, \code{\link[rlang:.data]{.data}}, \code{\link[rlang:\%||\%]{\%||\%}}} }} diff --git a/code/MOSuite/man/remove_low_count_genes.Rd b/code/MOSuite/man/remove_low_count_genes.Rd index 6564ecd..0069bdc 100644 --- a/code/MOSuite/man/remove_low_count_genes.Rd +++ b/code/MOSuite/man/remove_low_count_genes.Rd @@ -7,6 +7,7 @@ remove_low_count_genes( counts_dat, sample_metadata, + sample_id_colname = NULL, feature_id_colname, group_colname, use_cpm_counts_to_filter = TRUE, @@ -17,6 +18,10 @@ remove_low_count_genes( ) } \arguments{ +\item{sample_id_colname}{The column from the sample metadata containing the sample names. The names in this column +must exactly match the names used as the sample column names of your input Counts Matrix. (Default: \code{NULL} - first +column in the sample metadata will be used.)} + \item{feature_id_colname}{The column from the counts data containing the Feature IDs (Usually Gene or Protein ID). This is usually the first column of your input Counts Matrix. Only columns of Text type from your input Counts Matrix will be available to select for this parameter. (Default: \code{NULL} - first column in the counts matrix will be @@ -33,14 +38,17 @@ transformation will be applied and features will be filtered as is. For RNAseq d transformed to CPM in order to properly filter.} \item{use_group_based_filtering}{If TRUE, only keeps features (e.g. genes) that have at least a certain number of -samples with nonzero CPM counts in at least one group} +samples passing the threshold in at least one group} -\item{minimum_count_value_to_be_considered_nonzero}{Minimum count value to be considered non-zero for a sample} +\item{minimum_count_value_to_be_considered_nonzero}{Minimum value in the selected filtering table required for a +sample to be considered nonzero. If \code{use_cpm_counts_to_filter} is \code{TRUE}, this threshold is applied to CPM values. +If \code{use_cpm_counts_to_filter} is \code{FALSE}, this threshold is applied directly to the selected \code{count_type} table.} -\item{minimum_number_of_samples_with_nonzero_counts_in_total}{Minimum number of samples (total) with non-zero counts} +\item{minimum_number_of_samples_with_nonzero_counts_in_total}{Minimum number of samples in total that must meet the +\code{minimum_count_value_to_be_considered_nonzero} threshold for a feature to be kept.} \item{minimum_number_of_samples_with_nonzero_counts_in_a_group}{Only keeps genes that have at least this number of -samples with nonzero CPM counts in at least one group} +samples meeting the threshold in at least one group} } \value{ counts matrix with low-count genes removed diff --git a/code/MOSuite/man/render_report.Rd b/code/MOSuite/man/render_report.Rd new file mode 100644 index 0000000..e826af6 --- /dev/null +++ b/code/MOSuite/man/render_report.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/render_report.R +\name{render_report} +\alias{render_report} +\title{Render the template report} +\usage{ +render_report( + qmd_template = system.file("quarto", "report.qmd", package = "MOSuite"), + qmd_src = NULL, + ... +) +} +\arguments{ +\item{qmd_template}{Path to the Quarto report file (default is the template report in the package).} + +\item{qmd_src}{Optional path to copy the Quarto report template to before +rendering. If \code{NULL} (default), the template will be copied to the current +working directory with the same filename as the template. If a file already +exists at \code{qmd_src}, it will not be overwritten.} + +\item{...}{Additional arguments passed to \code{quarto::quarto_render()}, such as +\code{execute_params} (a named list of parameters) or \code{quarto_args} (a +character vector of CLI flags, e.g. \code{c("--output-dir", "/path/to/out")}).} +} +\description{ +Copy the Quarto template to the current working directory and render it +using \code{quarto::quarto_render()}. The rendered report will be saved in the +current working directory. You can specify additional arguments to +\code{quarto::quarto_render()} to customize the rendering process. +} +\details{ +You can edit the copy of \code{report.qmd} in the current working directory to customize the report. +} +\examples{ +render_report(execute_params = list( + counts_csv = system.file("extdata", "nidap", "Raw_Counts.csv.gz", + package = "MOSuite"), + samplesheet_csv = system.file("extdata", "nidap", + "Sample_Metadata_Bulk_RNA-seq_Training_Dataset_CCBR.csv.gz", + package = "MOSuite") +)) + +# Render to a specific output directory +render_report( + quarto_args = c("--output-dir", "./results"), + execute_params = list( + counts_csv = system.file("extdata", "nidap", "Raw_Counts.csv.gz", + package = "MOSuite"), + samplesheet_csv = system.file("extdata", "nidap", + "Sample_Metadata_Bulk_RNA-seq_Training_Dataset_CCBR.csv.gz", + package = "MOSuite") + ) +) +} diff --git a/code/MOSuite/man/resolve_plot_colors.Rd b/code/MOSuite/man/resolve_plot_colors.Rd new file mode 100644 index 0000000..7ea0498 --- /dev/null +++ b/code/MOSuite/man/resolve_plot_colors.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/colors.R +\name{resolve_plot_colors} +\alias{resolve_plot_colors} +\title{Resolve plotting colors for one column} +\usage{ +resolve_plot_colors( + dat, + colname, + color_values = NULL, + palette = mosuite_palette +) +} +\arguments{ +\item{dat}{data frame} + +\item{colname}{column name in \code{dat}} + +\item{color_values}{optional named or unnamed character vector of colors} + +\item{palette}{character vector of colors used to generate defaults} +} +\value{ +named character vector of colors matching observed values in +\code{dat[[colname]]} +} +\description{ +Uses \code{color_values} when supplied; otherwise generates colors with +\code{\link[=get_colors_vctr]{get_colors_vctr()}}. If \code{color_values} is named and covers all observed +values, it is returned as-is. If too few colors are provided, missing colors +are generated and appended. +} +\keyword{internal} diff --git a/code/MOSuite/man/select_mosuite_colors.Rd b/code/MOSuite/man/select_mosuite_colors.Rd new file mode 100644 index 0000000..bce7e2f --- /dev/null +++ b/code/MOSuite/man/select_mosuite_colors.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/colors.R +\name{select_mosuite_colors} +\alias{select_mosuite_colors} +\title{Select colors from MOSuite's default palette} +\usage{ +select_mosuite_colors(n, ...) +} +\arguments{ +\item{n}{number of colors to select.} + +\item{...}{additional arguments (ignored).} +} +\value{ +vector of colors in hex format. +} +\description{ +Select colors from MOSuite's default palette +} +\examples{ +select_mosuite_colors(5) +} diff --git a/code/MOSuite/man/set_color_pal.Rd b/code/MOSuite/man/set_color_pal.Rd index c603f0e..0759700 100644 --- a/code/MOSuite/man/set_color_pal.Rd +++ b/code/MOSuite/man/set_color_pal.Rd @@ -4,20 +4,18 @@ \alias{set_color_pal} \title{Set color palette for a single group/column} \usage{ -set_color_pal(moo, colname, palette_fun = grDevices::palette.colors, ...) +set_color_pal(moo, colname, palette = mosuite_palette) } \arguments{ \item{moo}{\code{multiOmicDataSet} object (see \code{create_multiOmicDataSet_from_dataframes()})} \item{colname}{group column name to set the palette for} -\item{palette_fun}{Function for selecting colors. Assumed to contain \code{n} for the number of colors. Default: -\code{grDevices::palette.colors()}} - -\item{...}{additional arguments forwarded to \code{palette_fun}} +\item{palette}{Character vector of colors to assign. Defaults to +\code{mosuite_palette}.} } \value{ -\code{moo} with colors updated at \code{moo@analyses$colors$colname} +\code{moo} with colors updated at \code{moo@analyses$colors[[colname]]} } \description{ This allows you to set custom palettes individually for groups in the dataset @@ -28,7 +26,7 @@ moo <- create_multiOmicDataSet_from_dataframes( counts_dat = as.data.frame(nidap_raw_counts) ) moo@analyses$colors$Group -moo <- moo |> set_color_pal("Group", palette_fun = RColorBrewer::brewer.pal, name = "Set2") +moo <- moo |> set_color_pal("Group", palette = RColorBrewer::brewer.pal(3, "Set2")) moo@analyses$colors$Group } diff --git a/code/MOSuite/tests/testthat/_snaps/E2E.md b/code/MOSuite/tests/testthat/_snaps/E2E.md index b420659..ac833d9 100644 --- a/code/MOSuite/tests/testthat/_snaps/E2E.md +++ b/code/MOSuite/tests/testthat/_snaps/E2E.md @@ -42,7 +42,6 @@ no duplicated IDs in gene_id * filtering clean counts Number of features after filtering: 291 - colors_for_plots NULL * normalizing filt counts Total number of features included: 291 Sample columns: KO_S3, Sample columns: KO_S4, Sample columns: WT_S1, Sample columns: WT_S2 @@ -82,7 +81,6 @@ no duplicated IDs in GeneName * filtering clean counts Number of features after filtering: 7943 - colors_for_plots NULL * normalizing filt counts Total number of features included: 7943 Sample columns: A1, Sample columns: A2, Sample columns: A3, Sample columns: B1, Sample columns: B2, Sample columns: B3, Sample columns: C1, Sample columns: C2, Sample columns: C3 diff --git a/code/MOSuite/tests/testthat/_snaps/plot_volcano_summary.md b/code/MOSuite/tests/testthat/_snaps/plot_volcano_summary.md index 7b248c1..2f790e6 100644 --- a/code/MOSuite/tests/testthat/_snaps/plot_volcano_summary.md +++ b/code/MOSuite/tests/testthat/_snaps/plot_volcano_summary.md @@ -8,12 +8,23 @@ Fold change column: B-A_logFC pval column: B-A_pval Total number of features included in volcano plot: 7943 + Condition + Warning in `ggrepel::geom_text_repel()`: + Ignoring unknown parameters: `segment.linewidth` + Message Preparing table for contrast: C-A Fold change column: C-A_logFC pval column: C-A_pval Total number of features included in volcano plot: 7943 + Condition + Warning in `ggrepel::geom_text_repel()`: + Ignoring unknown parameters: `segment.linewidth` + Message Preparing table for contrast: B-C Fold change column: B-C_logFC pval column: B-C_pval Total number of features included in volcano plot: 7943 + Condition + Warning in `ggrepel::geom_text_repel()`: + Ignoring unknown parameters: `segment.linewidth` diff --git a/code/MOSuite/tests/testthat/_snaps/plots/heatmap.png b/code/MOSuite/tests/testthat/_snaps/plots/heatmap.png new file mode 100644 index 0000000000000000000000000000000000000000..92664de7d329646e403c061c66235be3c5a250ee GIT binary patch literal 23016 zcmdSBbyQaE*DeZ=C@n404blQ4jifXPN=r#eBhp<8NOwpnrF3^GAl=rrc6x(0^+E+PKVWh9%mvTr{F{dp5<4o@?nc(~MCVUljYtw}t41 z8|@zqROWd*!K`1)UwlRKdvrQ*F7;)I5Ou4DtE?`%+M=O*=4>^2&vR|={q7ukL^X?c z+#DT@g}9J)Wq7fyeYLff-~NZk0H((PD|1*ZQ!G6q$UblGUUZ<2zd1#16|hXET*PguKu~{}iuI?oKQWRsP*0NO zQEtd}>vSOU8qKj567u^$(_w<#-wGJ1yCplH<|Qf83^({)cvVWyTC`64DTS9k_Q0RN zQ+*uIWEb~406R@}dB#4lh|R354g1Ep#te0z20^E;{(~LbzHqCds#`tjy8ZWDp2243 zoRLIR?0G+DhaZAnzjh@qD>(F$(HuNgk}+1X$PpG6nOKWmPiV-C70j3dyF=CAK5ah; zJgr`RU;^{lWi>V9A0Ob$GWjIRvKzc~fTNZp+^YUPHD2sWkF^T_7oE^Y-DC{=j>is{ zN9T^}DTyeHQGA5x#36L-Y8Crp9bW1c44K$^mG)lYi!&Vx)6rdsX-#RwD=(rcqIX^k zw-O|Tc8dJ)ciAR*tdA!VL5XGNuC1SugGRjm_RD(K+b^f13)}NQ8PBc}s$Q92cWkW> zJ{HTqq4_hA`*ZKDDos6xr_0+shXGU*TbdCL8FrZ{zf)4`=;g;mR2h^}44p5HLW~Ca zW$$yh$5FpGI;l(10V-zJ;JgFVqd(QnZeJ8rGZ?_sST zT=!fpt#0i7hCQt*u{o=K$J9uQUH{Eby|wXTy)_;!jB8}iJ6>DUYE|4@PkPkQJZf#U zTcr+#6pe(lSXC_z$}+xca;u%gD7q0mYMkp(Oz&x5E}wKhi?ZlEiK3wQTAEuH{@wRJ z%`WZTymyDr0-K$lo!&c&_i0k*BQASSEOv`BO3+r#;+1F8#Iz<@1s@rG5c=8j(@0Kf zo#3NCssX#JBTpV)D4|Z>z4l@oqdbp%Z^G~Ix2^Nb#(qD0^*rt#gM0SU9@ia3>m`30 znP)`QAFS$J{dbPC9X;iQriy%iz2CPKy!*yo&;5xo{oLk~TlJbS^KwK`Y{9dVsOgoc?I5cD;^tF#CQ*{M!|TVmD6SpEferSA^3pS;p_v z?(tqS2%KnD@?kCH-x;`g+x^trbg5wvAzwJ#`B=r7q4mu?jCa(p<%hZwaep4g){(Ze zHQgM-gnNVT&Bc|g$Kjokd4%fpn>#mj&ggB1W8DBCc#Sn=OcWFln85ES2#5h@2uR>J zMDRlleh?5~>9GI&1#uz$&VT(5{WB}gP!<6}1VKhZ^p!K>P6~1|zT{NEd?*VavkaXK zHo*%YJV6P`WyQzX{&xh0e3XPR0=t3`F-#YC@%ixd5fGI*C?EM!>QkbAJVc_Sk&a8A ze5}{h*1O%)x4qlEYkwmDY{e#dcXP9_DphNBK6Xy_KvNV2+ZzFi5&;oqLY8uJY^DPP z_Rk;05fE3g5N|&%ARr=5Ag&vsBBF>Oz_3NU&q)6H7Ox29sE;5XeRp1At?W~qITqut z7?}jlNzDk4i{s8n8mZ-&mx?7^)Bc^z3=C3^+Y?mJuKvFK8586y(kzFBy+A$U*zyt6 zczxiD-H*G3_`exv(0rn4Y_}&kHfCxLJ7;@zu)V#Pkk)-2>(L&Ap~0~A(g=vhZwg+T zz~^F{i~!qqCeXiKgmWbL)TWiw17E}fFPQc|Q!@hm%0JZLQ*ec1A{AJzNb@@wO7W7a zH{$J;lHe1eMGB`lGzJ*Zw)Ho-sW%xCy<+ksx8v=|QseHa$P`wWZ!}@C%<5evHuVN_ zo{q)`-Rw=$Ro1ha@0NZ!8p{Y{+xmkUpg3|?d~VLyEX!0Y&{D~L#aLGsrs-K5dvdmx z#y&YY$GW3-CzV?LToR25pFRbkiVpRhdLq6|&GXBmxGly4!$NT&8xW!7K%q@WP%qF@z5bi?tTSEI z?~Sf_Ee0(&w`x?h;e6ykqsK);d;kXg;$~qODnql3jLdWV;o)IJ#lbMa%MZok%U3S@ znDCjDFkoL~Yj1ap+`qLcpK6*2Th@i@JVY##%PEVZ&Sy7gN_;CZFW)Hs4xsRi`2I3y zDr$VH!onEX1P41F5iquW1q8&fz4Ks;tvvN2Hl8`>3=DEX-ooz4@l(g0sg=-0Qt-e; z9wH*~V#w@2f9<-FWq10=fKmCYL?n6s?%AiM0FSM)f`h~UXM~+`5)EhbH`i6)+}cAz zLZ}JejpnLyy8d0K781A7ZSrgo+;7E`^t_J+jBG{*4EwGj+4Fqkpo1p7gUB=)XDRus zoBO*!XM4UjJtiHMY<79c*_ zs9J}u2j9QdVifZJ{HC1oX^Erl0Hb1s;^s79a^R~5xkj^i9J?Od%WQd^f^ZGwUW<$4 zoszzfYvPo^VtJ__P*WlJ=))W~McBGqReALJ{W$|r$ z?ZnS+r-NOw%vqv-_kI(S22NJlq-lO#iK`vr5Y+iBuk+!CP%hrYjLINS5Ou?RLTN(vXI3WP@-%Gb>L+;_2Z^o}K0l4EdB2uaKJR%^@Y>^O z)aN3OO^0b**R6nW+)9+fD2u|H=XQ2>MsxKp2d7KnpX0XmZqC)qYC10Vn)Z~E_ME0Gtya32i=G(v zHn<)|oy@th&zHY`L=FsT-*%Z1n*68O=9;xs3$1V0iTzW=qR-XKRX}fYn0G5|y&KWTkr;!s=vvAAkvRS+cRqVB0xP zaBDt(fLJ!)~3QWCh`jxAkIW}RrP+ccUyJ-E1B z7h8kqmB=ox&bNxPB!eHAc&+GpU8#aY%%E^1wfo2KvVP%cojS+FieE2t6j|e}i2c&~ z-|-^S8+_oRx(A&j%qZ(DD;ZMZT{Pi>)Ix5@F+DxRkLP{oBJSY_vN2 z1rI~MVePG@x+x~{*jPtxE;H#Uy{<4<<(eaLZ#o|v2q0y=-CJKpie zsc%?XZX2Qf<%p_iW4Z&2#@%Z7vjb%UY15~91N3xsA2P==EjT$j#h#Wv6m%};^IHEB z5V8=@s{M4CT=9*#_XAtY>VsF%$=D{F4jv1`-};w|d~|QleUV->xYii+6bJrd(8$cw zYDWDPw+J2kf#@)~I2I0_{>_6ZeF|`136Cu!-Qoudw*CWqguBSMIFERNQf-dG+y5Hz z;?Z*S%h>kon0^A&uhAA{dcq6xyI*SJ>fVXI^=~oFqMJ5A7c1MN-F2zDs>}2zUi&l2 zvCn5I`u5n`j^|w*DF$~~nLqtPs$P))FZti_QwIU|1@ML!&BC5*!1KKNDA?y#5V^AiH5R}rZ~Ze3#q+TugDi)?_})NS6efHnvT#mLl@ zgeryGB5ua>VyD!kmpGBjH0+7h)T>&jJvIP>kIlvlv>A4$tK$8TvATK^xr}G3-yK|? z%*z$&Ho*E9n>~-s>b`zVx{JIbKtqfC1k z*$Oy!qVw}vT=v@tvjENvA31<2)30um0v2+Lt2G4UFg!Fu+)w z#Q(LdPum_T1dPlTk%7{ z7~aXJO9bH_Twm;Uw_rW96uyotc5NGSdCJs7oa%M$a!6+Os~pWaPpzQG;d<@gCh3p; zO|vX}~CL22!qi(e7XrgGouEe{8~$?02}k zH?JUJ>&L5OufnZSwv>|a_Q987P8j!=sprr>4 zjbkfT<<=d#!KG|Pls$gX7(T7EfQ^_ms4&4NV9N&(bA`a)1wKYZ0@CXWG6MjO%S>HO zLQgtXk7MfBRmUe@=5Fy6mPlew>T!0f9$zLTZ4kRXkPfr3R2C1b=_1DAxmrnH;e48a zrwuFjHtdeifwLh5Bx@T>I~%7r;IaSQAbO_CKLtAS+mKrMnA1eEA~(#Zck5Dxt$3Brpc< zp9x4IL(1V|Tky*IU`AAGs^?Ju!t;LypvDV))Xda)xY{eQ0dfd!1S(%8f}$JKNZ^4P z0xU?;n{8d9$e`=?;S_>xtSi-ee7pa+DG0FSb#D2yTLXv%2B5Bn{v6tW6oz7}>8EEq zRr5dDk=jn(8`HV&&&q?x^?pa61c`FN1r~6hEDG_?J!ueLWNB5HtAHc6Om+o=PlGbs z-(nlHbyYF!db-5i=Cm}=Lr`k^f-X=fn|Jf@SRkv>hrm;=KUK(hEML>^VyCJ*iQB@c zFPU$s-0bDXTti(?0!K^c#nHH47NCYEN1a1iaw|WODPn&3A$MC8HQbXS#0#v(=xjTF zLkw+SKlZ=T(-+{bI$Ql8vEeSVr8kbK<+e*ces&SNFN0UwtIux{KDL1j0lX`0Ap;q^0= zgeOTnrC8FI0XS;Pk*_M`s79xMew)ZBul1!E12*{eE5C6U{>D&NaK28RTB^sf<{+v@ z?VZ{FXE!WL&#uZzh21qCuxinUKfA6jx13bz6FPY}N^y_(-2NqWxb0gaOceYS=J3ZKSMdKNrw1PtH`O(&zQ=)S`PCELOF@Z1NE$(3g+~e6yRDr{UcQ-J7wmj^f z+Z=-p$oe!W_s84<%!EhCkY4t|^J5OAAPv>&8!ocMDOJO+{@c}6%YG#f)muZpq? z5m9e%9x%7LZ>F-hsKiEt9le7BI07@oTb7q!c<9wTmvny$zg-ssqA3bEsX=&D-rEsDt3K(+F-L_xC2^!!!^n7xh0V%f-5IByP(lJ^sboQx%Dnfb zHGDC)kPSTY9Pp(V2EK@M z>Ng{pO%#85m8YhVt5(2-N&F-NOZb#>(WB||Ab2EKRZjTk@-T2b$Q}#KU&z6S4%#2F z{}*6NL)-AlCPy*F2oOoC{p9Lskz9e^pSQ>9zo1i<8U(Jf=a}DDx|ngaI(hShwAp zc6-%};e#DrSS8vYDAgeza39C4{?AWzoTVVho);ux$oEMjjJxBYR2lUHJ?$Sq41W5f zM#aU^gQOv9*y=j$gA#{GdB7UX3!Q`!ZDL8x&|b&lvi>W%P4HN;fwR|5SnNA(B(ok-nj^06ywXQ?B1*D6>0M&ndi-sI2VOS@7 z^YbBhq~t|1w}9Og7ExnB%as+0#}6gqdahQaOXf?-#Wfs)*`Fey4swYP?LwnZsX$1q zq+fkxKx1OF4zb`0zn+0|D_6iIq`?rXxb>31+bW zQe6WLJ_xD=Adu-@nUCNzzRsc6iY5usc&nzk_m5_e1rNJz#Vf4NbnIvwd$QR1qHH`9v$-`>=jo=Gl!*AIjs?-X z{;YdCT?r^Le%6ersnpeGMYik>?@6W;L7&jPUcTjX+>yRz_B4zIK?$+NligY4Um---?SFQ}z#gG9-;IWDc8WRzhy`Ui@pzf3(%EKSkr99udQV{9 zobOlV6CWG+mRn7a%{;YT5ZM4Ug_Pf3S~iwx#S4G_-|?=90g`My8!L#QpLBv4hYg(L z@qq0iS!;t_Zpka-7~zF0%p^8#G4A8>&;w9A2Eoi!-dbkF&0(2dtL5JZHyPC+3(J1n)D_S z{QTWUsP`ng!k$wN9N8;S5>1Z1;R!7!!!A`bC+*3|-8jhqP-r5OlP!PQIXIRbD{e|K z6BzHr%~e`yYq;uE+AoFjbb*vS6_h-kaG;)nB4Q;SeN@QZzM+uv+BTQl4-X9){r>qu zC0m~844h(jPRIqF2Us+_Iyz8V-z^BkaO%=$P3hr@j6d{5-AjE3B7Iw<7b=R?^AURGCST@2OByz9?aKd)vyDwoWg zD;eQvFE(hwAPXJl{;?U70kHk6&RFfH5kOLiYKjiD0nZ{-zn=|4mO1)jm&4U>2+1Hd z4dqyZv-<&q29b%R14Yn(J84M}t;p~I&P5k5{%=8~W|sB;KxA_$lKWz`At#;ru*!;4 z6!qwxjZwnN+EGEfnGe5>D**if@QgAH62Sft@4iQnM=q&Ko;a+znua(wam1ioQTgZ zQxmzt?Zny)WUfYF`5Pc>@z6PL7TI2OS|Rxoaxv#Hk)+J-*s&bH(NZg;*lXzthRLYc z4XJEobTXTFQNFL|PAkm5*7-ym`pQ6rQI)k^^W1Z4WLF`{gRk zM?;wVL5idkr1~FFscvUrFHCUJBSS|*D*ZxqR1_UIt+u&r_N$ndxYpGx(nyt6*Gidq z{DlgGmU~NEQxspOr$MYS?`7Ty4nx+Wrt8|jd-HlAXGU(vx)-!t;NDK=)B!3wQfFYi z(CRJEBlHI>9iN}9uA$iW;6%goLN<83Om#*9^_CvbJIT)k<=s_7usU4dUpXh$AnLDl z#p2D*c2WRXn!M`t+PzV`nE(~9IIL%vFF?6qGyMJqImlW;S$|!(9qzJzlKrnw&k$>@Pol!(_Bii{-f^-LU2AhS+d%cIyuyi*>mvkWSi z@u2?JZwK-^Nf+6QDdvkbS6GN)5+8WsC*`AEF{*|KjgQQ1YJr&G#xyp_f-Owt1o|c4tQ6E{rZ6DYF`Sop66MX;PvT}3A40< z6Da2$k`nAfiFU);443`IHV9wM#tTz$Ogzj2@e}+Bg3#WPkAa{Zlt}pTiuzAy_dFS<&U<@$ zVm{k6YTD^~yzuqbwGGmQ zlCKSXuLG03KZT=pgQut9WFg99qRpyLut2-j^wY0DYJQ+^@^?$X=dtXtoAZ`n_Qv&R zF`!sF5vXr&ZoVK%Y0J?s3IKYga@rb?>_pYaa-!HE!TbDhu+ZGfs%ifh31GU|`kK-T7qWl=b?xOu?VT$@C|@?VJAh3C(W~-w%HvH>-O0L{z)4HdRBr zl>edz*q+JEaVJ9>#?0>C;@G?S{iXJ99j943C|I`N8dCu0#G9@hLwJ5+J)v~Bg_M*@ zHP`6)&Dj2y*X0rgmCovqji~&_jbdTMohr4v?1k7nhe8qvU#UQ$dMRTdT^N72syrItop9)JRLVA)mb^&!TvNeW!9o z49)zGy``vJ`oYu#%+UH1+kbL=5#V9Vf>O7^*st6slO5Mk{8Cm?%o7iSPKr1Uv4Z_U zdsV3}#>U0Bi0xo`tPtx{#~#=aFKRr`ouvI;+Res=_Zeh;FqG$e*HWBx14C;y)*_B% zK9#=bsr_m?86*2QIL zBIm=BO{UUZ(p3Jwx2h=8anN|0kL4xPaq%~pEy&YXZO$!2NXk2dPLdz~tWc=_G~dCJ z1_UrP_!mf$khDLDjGH}e_s&Rso#lqib&u3H5f6T)HxQ6)UTDlJZSrf(dZ|AnF29)E zquX@uTDlq69FSr$2sOdbxXU{_Mc7#&DrE4Tuy{czNNG&XL^O?sZx>1s1Hx^Z=22M> zXzQ=0lHEL#%b@atG}*m<&4H;}*3%5#*zmS*=(XQQE8ZhvqNBG3|h=ZBh?4;rQ($W$FyN_=O?nA>>H> z{-mPa>~dElp7*<+v6X?voI=tQ)K0Nk(Z-`OZTelH$cUY`X%bp?eV4NS;A3rgG5_QX zy^)*q@up8eB!OCNjhR&^vb^?o$|liK6&p^dfnelY$7X7EZHW)s*K@HkYt30a^(yoc zOcY-~M^TD0>aQDiqcR#vV-)t9!(SzXAx4({gU9*LLd34#&ONW|v$d7Fy+$ssG6&Qc zek5hDo;D&-bq>*cI~(@ZMhC2jzps5|(s^-Ef1|Qc7xem3!;0|xMm0~A zRtt6ukXevtz5wLmX<6YN!UDhLWuw6c_p1V1q46x`HrD1e&-3rwa}CM0{-<~#F5(0mvR(k$Sygh^b*e!fzgMT`Bj2b1>p){(cbsJE z?;soNu#VzxVCp{iFDkgwebCLhVK%!JZKpEGUpp>n3UU@hKw#9&RnaZrjOP#X#-Dd> z719L=HctQYttI10>%E5auX+%je2p%C;tsaWB%XHXF7Ko_!oTckYRGCdH+J8ZAOr{q z4DJ3bh$<^%+~-px{3~jK&&xM}O2*clB>XZ=>tHL|UM}-WwCeA$>A7FwO0PivcM`F6 z&xR?QJZjAu1E4@Db>3fW<}DM}(_R9#wx>Evgu2eZWsHLm((s>J!;2_BUe||dCVH~~ zi-;ed7wA-g+#0%1hG&j_e|K?WWpEzsg#NxyUdM8FP}U`S0-CJlaGuMB-&v?t>n2D+giysv)_8&LQ@%2j9JN4qFj#m#z$@Z(46GQ3Ra)y7P5pD%y z1ybW8hQV-UAXDcR6={D}WjTr4p>qj5&q#Whz6f^wg;0cU8zBM;vhpW+ zjup9g0+oc%TFdzXfqn!spgeKlh;>+@}$?QYF2GKe}o{b(i>1Y zfr{NV>pRIaJ!^HBgswR#LsJBl_9lBYoI{Z=bB`6o~8Md;Ac z_J&t^PyH;k?zxuVR+$>Xicv02*U!5X3GqfUFSl2P2@<_4y}8#D+?9O`V3%n(mr~_h zVjh93n4awPE=zn+GI+rl1~P5ujzfE^&tQgG-@%4{3zZK}}5WWU<+64r!2T5LH zYn5oliiAblRfUNnwqj~g&;jf%h5F5jVKzj>?_BR1#A2bts1Atv-8Q~{sZKjnqxr$3 zi7h4fYY!t85nhgm^WV|dUgKvYtydhM(68`(e?L=-v01pYl-^lpQbXHovA+o%UUzf` zv~+bo3woUY#q%1t*$pgxwvd_DA9~Bkkzlpi>M1u{QdcBfJ%$9vIwT~5_w%kJM%l{> z!$&(s&nlh=>&s3QgbN)fT%PrN#ewu|H;7c&YQ^Uu=r6XH(PUf{NHFopSF^=WOKz#G z#BA9PrT@8y%av4qmi5ky@vtlz&a}wk<$f+a9@gH?+zQ{Y&NOXgo#x$|f-}$IE-@8dk!@F#xsWX5)oRQ?8bwZaDkJ32H-ClbU+4p!no+@QI zyWr|85>oY}ztx0b`$R%e^R=rKAwq07m?gY<{i2=RA*HA?(BV>5QXN2@Li)3UxpWI( z8dh|s`_UDjHJ$Da?cCUtYM4IDQ(BewjEv^2Sh48MRnd$1fJAVd%yQD(tg=6<^zI%~ zHLuwLyhhX}FH%)M9R4vR1fy(Kt(`molf-1v9yKZqGfzPJ3Ml~8Rta2&PZ!o!gw)z8 z;&olWZ@3l$!2yw1Ay8P%8O5d3%Y==>jyDdz{`945o}6T0P&oJfS}=Smrly$t%FRC6 zh=M;#FG|E+tIcjKSduoL(uY=3xMO~Z`dJe4ZSGSU#d5B`W?*`+;Y4>Zd{$Ju0i>Vvudm|7cOQs@1PHu=~Z`IRPb@hNV0twJHxnJ(LQiGMs{Kescg@MD8U`n~7HP95Z0)k~dILujwMPcZ;=jobBzt`>Zga>~sOzVHLDGeN z6GP&zhUvXL?Vft7&P|mQzIc&TN6&oC*;|8NxP>OCm}DuP4Kq9aoSF> zo{T4wxZg@J^@MX>CNFcK<)NxFo>V-yH4G)jB)t?Je3!$VEp&;8zUVs zP5~Ewg#GK-<6@=H%rIYb;95o_>*tVHlVjOT>G5f4s%(~AX9Rk9-8hSSVKS*;!nARI zS!Q<(Bc7vIKFvr&&bg1;{%ATo!W1>zCjr^obVD5rK?=wTV7MsccgC!69hQ(&XtRDM z^DGfjb8g$>@~c$<`anYmF&)gyt~QytkZ!?sG%d81C24S z5y$d2$F;O4u2~;)vkeU~%b4ts zpN#)uz@u}qKUGavz0L>%nr_$&(RA$|kQoRnE_}~P#Xb6%waYN7`BAas90&_rz8PuP zQEf~VW=c>s$DMq)j6e4s^N2snD41W+oG`c>#tB0V!^Q8sW!v%Iea}6QM%6jp?@XFMsXS_wcU_n$YJ)R1clxB>i58d6RzfiYf`n$go+x5{V z@3g7zleqhlGK%e&Q4ttClPZ$FpLx{%+ZMrc2Wj??FW z!OMJg%BF{ho}`f22;v6fL3^Z$Me z@_G*u^%RpTh{PGYFH|?go;9{)wKcSDRddq*Sk3 z;JA)c%IV3Y`<=qwo4&#-vQZfi?~E1hEN7IMAqGq=`{E%@+>P}{h4yqY$eVu}D5Q9n zfeQDrXOe^5Pjy`vIz24aPC$FhM`4x6HjkcYoHI|-)l(@bFFcA-|AJ~C@X2Z3LmkRA zL89^}La6ZFZEir)b={yF6bfp(xpp(mbPcNADy-|7YmUtC6OLm_M3(Iyy!zl3W>)K0 zlUhtI#IC$(>C$`JLUBzAw6J)yKV`-hR|xqvKfkD9yi72+BH#F0+@SSa+iKEy_nN+Y zr;91qo%4QJI8%yFP#8<&Twy+1FN51!gxK&zBISEYZhH#BxnkT+PW-ABL00}9<{j(_A@2{Q=S5VK9 zt4CI%`~gB)v-I@|k#`F7Va#0*(E-AOqS-g}=T`go0zkG|3KSizD$#qGn>)uI7Hb$b zD_4}*6aN)O;!R*}ho9UCh~gp*x->JA%vK_%Tgi13G>f8qp2}wI{rp& zje#e8lOM8VL$)f*z47i4WPwKl_L2^iNZC68KV*aGXdjdPYU#19@WpnS-IQ65q<3an zQulMZX4m&BD(hjgo5ou}J&>6k+8#9iq9 z{Qe?W)n3416I6v6?SO!hq@CioQ@be!j5O`&<0#zxJ~sdG>wI&z`PiWQfkg;UdB9}r z-UQV_8)5tK$hSxVREvK?yCuT>o4h}S<0dFR0sQu$gpQPI2^~YuAG{rf`qOL_T1x4~ zEQ%|KG0_vpa{Koh1?FJFjw~m3HFhh@3qSmPP{?ec4uJ*1R4hQt3xzBpxWh(9%D3_@ zAQ~PdnW}fO*0Q?V^laHYH3X0gX`8tAnRz5H$*KNRgcYH*M$yn^R$}^}2~a3RD!aQV zBh>MMhw6VSf)IRO!z;nM_zssmkz)AKKk>d-$NW=kjTHGBR5XSNBMtWonz(Hrc&7wP ztQSm~2ynx}4hPlGe*yRy^ZxhJz9gDrhrk;Z2b)O@6fX?^0ju-%YwrD97q^2l;uuVrCtv!|vu{E8}TzUCr^vapra;jXW)^W$Y5+z?XFYX!RJR1Y3wf;xO zcYymyr?z~Opo5~QkeFFRfRshERDzhtdOLh|dIibS3UP0?PW`F%%p+jFE)U~CaHvPi z@w6I+nFI&gD#f^FkYfsEH)_!H5;yHjW&~k(Gzd13$-fsYZWT2N+xCgNV;8G>LnsBh zSfYV!>Eoc;Kswm{=O0i2Y1)GKC!M3-hXf0tEO_th(9jU9ofMSIweMCdr3rtffI$w4 zA|a&@v`z=>8R1E-QwLXo`DX!%?NH5oQ!YN{+MI~4P^5=<91RQf@xbLiH#pLjj%7*; z3fyU+WGMsCO;S>`-J{BC`d$t%J$Rn)Rt$gwa6ti*KVa(|%8kEwA8#tq8Q2d++k(t` zLP=z;_jLTy1hh(kTrX|7;6b4M=7>zWqMbJ9XoKdWwQXfF#0S zD-+`u6r2DkROfMGz;#VN5Qs1n_SK*3vt8aze3FAo^u!f2FM zGBAVPTnxWk){X-P33?G6bK9A?7zUId|3P-j2ox}g#5c(}R6vFD|;*;M)We2o&Z)&4XJ4jmJd>>1as0#2Y`gyc>X zKCey^{UvYLFRu@D^h0^-?B8E}@eLst(gFbzp1bB#t0`Jg*@}hEH_-S;U>Ayaf}4JK zd#?5eCp2x)-G!^!=w1U=#%k?1sG}K_;%4id0wN&UK8~rvboINX2#e(EcyAh5JxFg& zf(m&D12c1XL(FYyS{&(D7#TAr$tdP_VW2UFd$t!a?O4zYN{kNrQH&-_jZ5`^z|3ZA zEAFU88o$G_mGBPkc7{s_C?iqdp1eQW95n_aOR6>~FfqGJ(@dqYxQq0kXW5L7WWTcq zbtZr#VhE@j(REjIB+j^_6GVLAKC0cxGe(h z14{A5CQ>lmZJY0axnaHHl!OFr2#6<;VpN?$JfoN^)e$~!!$U$r9~sLvyN*%sg1 zdoijHc22$erFv{s_-&QgO~t&wh_lf2-D-0fH>Ymsa}dx9k5X68TygQn}2zZm|;aSkIs$ zY6I6o&0^qyUjW+rQ1E5EDV!G&2m6CQf*>emoi+1Tt%*X5k64?Im&?zH0l&5t9RP-| zIhw#NAbkO|Kvhk_hZ?@XSp|A;N!htSq`)T}@d5ynf36}Lkj2na`+x=qX>;@3WRK%X zoZu?M_WLzJn3D;zj}Teg7|sdbo^N{gMvHp(-*T2fBq#`gng|J))jBTE4qJv^dtDtt zLW*vXD_sHI7BN8lAOloNEkiiJ*SKb*f)<4I#s@(6KnL{%4Q5Emfigbq z?&uhl*fa)0#UTI}c+dX3LWw}S+ouj?0OqLfaeEVN*k<)xQ2HJEB907cpXGrp+;MM? zO!_5|7)&;L)V&7jW}j+ELF$QFq26ov%9GL&%IMy)Y#R&dOO0k`W(TuQ^PNx{2GSWo9k@UoNS+*G7>{Es@13WbN56^FeWO`pm(@LR zD>pVpB^7dg1%d@yo*7#|j!eK%>{epcK?|gG9Heucb3X*CX_-hshn~xdB?qJMKD{^d zO_?T<$3_?BlOdI9GGv8+p89}x49! zU6_j~4~PK{z{O%Xg!JrgHO_{!iF|d?NDrj(9D#V-Z)pl|>d5}pYJAl+t^&qoT3S=>w z)wW-N=JNT5zAAW?2!SN@E`Y|X<7pAb`{aU;1e|v9tyuA9AW@&qtUeKdHUn5~zBGdx z*nQTJp9(y)v{1Dsx&$;5vhhF75975Dp6LC|(+zgnir(V8_E;; zE)Cq1Wu-eFD`Oy22G0!Ck3cVu+Ae6q>QTuAV*byCraFXzK=#fDY92p#>3#|!k$(1H z`Oo@2kVZbMiW-1W-=}*m`F)uC&DBZv(Pz*v1(m;EFM*&MK;IZ<9F!yArGn&pykGv( zI>sUB4D=l^INhSY>1G_n zxpK4Ua*J`c{E57lH_4$Lc26&gXSiq?S^B;Q#*`*18k2G8=~ejQETw#sXKVWLJ)dTI zD;RrC|J8>gvK~RPF*mK}fwX9_5(d!oyiF8+ONB%zfkK}2qd#E&&;cN_4Hi{mD*vDE z`p1CaJjA7jqdEfkD&Xm<9DMLg5s-cY<1>&B1P}%Nzcm%y$nDqiEl~nmJ8y&lDk>Np z!YHxbz>WS758C_`B4Cv(lFuc<*o2`JPViu#@4sQ>;S^Ay3!blMKn*sGnx&bqZGYV5 z1dY{!X8&DGPL2EUnP)xD_1b4JRk1nU7_21Qk0A7LK zTc_4OveIh03p6W<4}I(K1i`)?AQhdX>UykD;v3XHML{o)F(7SJW_<4mfw}4&`EWxZ zFNOjIeNY2GXm)>0E$DJ!G}++hM5zFvQc}Bvsqs4f9cW#S0@CV>j8jJ{@YN5ozB15P zFaK9=Mhl1=O5u%bER$*`2;NjGEj7JjHp1qBl(XDsUKqRG=K_V7z8OeNqrnk%R~Y0% z>?z3L%}EQCK2W1EXqH_5NMik1?c0Q|%Sx=l?7$CtPtbJ;Z&zyexswItK0o4l9f^Ei z0e;^HlPw|DGByKqn3&T6tLCsQdnV4ah zW+4Hg4(l$Q*w_*R_5@y2QOlxJ`=qtlZlxTux4|6xmCExe%U7qsa|fj1m{#I6BVB`A82!l8LC4HSK_*^w#PMj+1;8?sx}g@uJ8 z))At@0mU}88C3LWSy>gJcPyCn0Q@sD;oaI^1MNc~b6jGeb0YwR_|2xEUDn_P_cu9c znwxz|2#0P;k$-_->lqf%IZ}hSZg9>HNQIH&r0heOcetN3XtNV`4K!i|q-`a^D70t! z3lH4l6p9*dYi?2Vx3uY`Flg4vRR@Lz?%5_;Y)_7uBtt!Wr6;fKV}(j{ zvMjdW^%s>`M9`K~?Vb}TydA;660dO!*$b(7@1D*iJ5EU&x&kTtwzQ3+11q~*>abJN7 z@>OYRDR?Ex=rWJZoZ#6>(+%sn4xl2?n?x*2S_%@kLDmIC8X+!F&IF``C83wNbQOT= zRb^rW@FPF~lY3HyrYBwklZ&VajX`u!XYXs!iU`_Fc*UC)ZVG{{ksfsM#Zq`(Ducj` z4!qX})#qThZm$cdGqTKvv%!@jl>Xjfi0$uBLEhr4;Y1^lt|jb&px`v0;wXYzHD6=! z1YnSVYun~B_~J3}>Mr+>SQNV#APp0u1LB6-BA}2HmUDIo!pK0?<3i8ExH=$_Zp_T2 zO`|h!1V((GA5X0Zki?_HV*F|HJ&cF?azy#@+|j18vY(W0gh#Tct?PQ@6BCI#yg*ap zuWS({3~5eT(rxM z-+~m^P=$s1#&lH?)FGE2kH>d1^L_>7i(>#^5(l3X`5kg!yX{mQtUbG#%;cM_|5~H8 z)q(3d_}~;OH4BUS5U9?8Q43+ zbKe)GMlxqWbZQJj$RR+cI;R_mF|yJver$ZQy9A8taj6|hZQ;e4PYO2O$6G!4NV z?7=W{AoA|*j{aoN;&;8X-rWq|>S0oPHk@{C#A|j9HD6vHrrm@XA5--^YU^kU!M^Hz zFgp8u1qW+Bfji`o>1k^;aF;?&ys-zCuK8kxX^=Y_7&ubkpeV`?!T1J+a zmUO}$!U)}$>(VWj`%Q?(OoN)O;n%b=o#<;F4a#HIbu z9Ug)upX(jVnQD&ZpegE`1wX7FbRE#Y0KGAWYTVFav9fmPLBTN_Ac|do={MvuqJIF# z8+qViHca^Tru%d0U@B|qFnKaKfOvy~>z9H==7cw#`K$bULKrtEW)D`n#pSE6IZii6 zz8n4`b_f{^OMz?8& zpkb`!tNzgvRkECMjyWJxq1#RcZ)oW?bx8co!ENCyH*vHWR_rR}4&3&j0eFIN9y;&x zK7VR_T-<8iYLbN|*&RnYoil^_o9l~@;+f|MIVDTeRyT$D25f2E_KTlEzka{#m;00h z^E6voL#7JlPsWMv+)w{aNdb#ea-Wgdde#R7)))DOrH?<4=W8yNX>qSgjoe2Z^9ljY z$A44{v_^AW)-cDW%l1OJ`uvY|Z)X zm?_W^>8iy2pp&6DJd0Z%J8lKg0r#;#9|~ak&#SWvFGXJYd!27E+*K%gUjfKM@vi(%&;Xl33h9?wb4ahqnt}&) z=`J<6FdVSFu6_Z+ER$cMmK?2FiR-*tb0scYQo8w?Stf~bDJB#Gj`HP=_K8|^`n^L> zqc`p46BYy!!K*%|N{!_jy^5wV3&tH5sSsgjIMNRh`?N*K6;kio>3!onBZohw#U#LPvZX{0V)X9 z_c?|iTyE=4UaTcr^3qE$nTba_?&)MuVV*Eyg0bg^AAWGs6qC2EA0IVplpH*G(Aea- zK^Wj#0-+u&Tx({*hUwBDT^0}=zWnk_(<1)c-~MK1BL`oL<+08R)#WVe7$i98k|3Q0 ztWHDh4C*l8qKhsvFC+eZ^#@cPUUcZt!AuaG`Sj)!pu^!)SBhfLBs@h5VJCkRC9myV}69cQs-&H9E6 z84_Z)wa(Ue)m2xSv6vffxFO_PtWGpfbts{ejV$j#%zDYM<2u;Io!snMrZV!CIf~vjop)Efe!up38ie==lZ?92jd;%=1T& z9&Ma~=mb5T#A9_`n)wUX(kwH9@YY*zHGj+2`gU9F3C=|G?9-=@sVnP8(fqrzUZ8wh zr*;RO+-R*EHuu5^--25XGWoLjBoKz`Pet&lW<3o$s* z7m%~gI?HDbQ<$f#(CXikdcX1qt0n5QTIT-Kn11Wujnx`Ad8o)(y(Omp{PyVuoq6j| z6H{ZXhg;+HW`?+b65~1Noa3{+)*43n{e8#MCaYW5r{1virAfU{>C1KR-o1V8+O>;i zwh^DL6ZmG%oM~pst0y(J$y)#Kv*wuibOi(f0?`tP>n>>ZcBSh{)mcD(!TLvPCPZo4 zSO=YWp&oIx`!Z6nmbMt@4=Yxz5be&3Ww2&p%eHOXjMuIF*43&54(o@^IKGIbE&6P0 znV4uds^4ppdcac0B*7EobX}#!>3DFggW6-wo)@bHZnDzucn!Kf*dMf;-VR%|>s#x~ z|97nGf`9+}--~wj`t4Jj^l#k`d(`oT{%t(|_~XVV?F!eiRcpDQAC0Zwx8HudS(B~9 zN;;II>uo>$@Iy1SVyhumW;(8`^orKoDeS72iPF;sO74+Y&PKr~nd+PGm@;&dG$#G6GA>WfH5Z3~%F5mR6xS$_N zofM^S@OHR|(>&DsR6)V-l2Ir6#4=djt43gSr=Nnt=bwLW3mdf|zm|AG_Qmp=TV|yD z%NT4=@Uj28UEk`WQ)fBr3#B!G!c4SMcdB;uB1I~rdMA7AvB!*SS?#sZ7UTW7hV)ZU7J{p(+1&G|4dDmn|>ju*$`E)UOhmOxy)qSS6o{ZZHL26f|u zygqC7End5?v|H1TZNc;n{l*(_G$QQp(hRO%?Pk;;4r|;hI65ZB`U8I1WtSO;@%p0` z$=~x^Z@nefSe97csbXS7-iPYaC+$M?2VD=WK8Ll1;}3TJi0R9R-yU^os=*rP6m4m0 zuqM@+Z@d0yjUNWK%v7<<%WKJ!C1xhQ9rozUq<(Z8&9~ov+xRb6ALbf#BMlX4-TKpx zptGCxML<8g#78$^(IrsYQdi&0x}BxEo%Q!(#M&lnqM-RZQ5T(a=FBl{bY{Oc1hmIZ zUl3HF^Zp*i+Af|Se+1%w9kBk0S`(YZnj|7Udh{^MYjoEkU4ElJq4giEI^xjH8SDtw zY;1Y@>8Hi=>}0y{bZL#{%Fo!NKNR|pQ-Awbx!V&PjBwv~HL&X3Q9~tCijM=n#vwy``~7m$d2Mud>lGSto+-Xr;e1`jYb9 zci)*8UKMEF`HTR8dX+JTjYsqm9ZLiE?%nINS`KD;kKYz`p{MrgG9>~8PLzPvv*c43l{%weznu=& z%Ye`74)$4dJ)Abh-QrcrX(r?k0SG|ADFO*4z)nFVUkE?|0uX?}i4utGSJ{bty2ansx$lSA&QIK)6cXH8u^w7*g!NSqP#l}oSL7Ij} zG$KOF(3(Z-G&rTEjOS8M&|pr^i{oUWxN>`qzNcef$QES|@bE6h;3%=SAE6r7*tC@_U&FgRX4#ZYyN;Gtw>8+$gJyt+s3E94F4E z;sbD#uFI3hqN{oJ6DBY3=VdD5!wyWBwazv--*kKL-%Ib`%f}NL&mGUPk9p<;d~6BN z_GuEiQMF02S}3}wun#)%Y@|T612kWxHhmxRy3Ct+HcaW`l&zfD=oNs2{{4c#g`jbUB=Gnb>Q;AS%| z-+GoWZg2BM`kHuh2a~K$qJzBL-%E6ST9zeMTr*BR>K>qx`p4{v3p7*H+6Qy^J`KnHT zx-9wJDD@AwwyW->^=%KGw4@``FT@y+F@;|i(5_gOZiDDlaK1iiT}?op;M))`;2tuwZUrWVm3 zxQJw$s{6L&wuLW!SEX|(>?^%_AMn;%?Dc;Hcw6VY_tIHDVjsMASK#i8pe+_qEavL@ zi&<V{qC+%8!$+48xyjSZ%`ASfSLU_0oI7qnY0&MG-NYm=xx4wHT`!Y6UX z{F&s3j~~pH)V`c~{*>;afRBerK0^efVcp@@cTVQ{{soU2-?}b37L*Ntmbx#WaG29C zX9j=cfU4unQ}(-3=RwaL>U^Fqt><_IC`pbL2Yzy0wU;<#>SydH2tF2RC0@`~j7(2wny8PlW1*SXLBfo*zqWuf*<9ZO%%@rp!iEX_OL>!Kf= z?vi&IQQp}WuCT+RBu??o2bE$crV0-9?pSvUKen1_z|$0fbG$Y*yf~Xp(fdV*f4XZr2g7R{V-8KG&K8P?f?7A5y4jn{_}h9<}>#hT^gEOG1=~kd4a*i4_eYxd1ge?$D}(VZN55NOvr3lW?q12!Y7Rb^A$yiW&sHp3m8gU1RAcmqR@Dr4(rWxa(` z{#)&vZ1?-N+Uh8aMm{J+#TxN!j%smC1Pw7!=5-6_btSzkxM}qk-ahltu7JG3Cd%qh z0$0TWo?&fuZkP8v9ORGupw)_7b>P-Wpb1m~i1JqwHlUrLyq*cI1Q=j_*QPlTa4K+# z`)WKs88u`K|4!RpzIzNz=d527O#8N|ue>W$Z}71I;v4IbTWPmc{b~%G2iPY8F|o|c zOcw!EOVzY-N|d*DZ59d%srGHY0PxQ_kXdRBZNsy{nPSwoUVJzApLPw+a5dw7;9r|N zE^%b?RE%dN_SF+vlQV&+Pl{qCpRoX<=iuc%OZc*~NhpiRDeosbtstDiqZ8&pvTSYz z5o}JL`cXfcvI1ETd=m?kh(j(@Q{DhzNcAR@_!l3@e(}sa1v!jiW$>m>Ve;OBOkxia z)b3%;TRG(yYuZtbHueIr!>dnJCX2fFX!?FX*iWxKeGXVY{g-)8VOx1M@~M?Q{fu+A z%1F9OL1I%yW?gaE3QlR*4!*#*Z$C=Lr1;AxJND)BmI-3^NB~)nJ>>fdscY0V3+!$j zFpYTY{wJ5i<)_Z}y@0T&*a^N?3v`mRKrg@jKw_Tr4t4~)Ka6*a)t!TZB1699tK^q| zytzkYuK`;zQ6S2CjgzA%oIotkjgn6VtVTe?K!h>KI@C^fk=Z#Piju>?YHfX7Tkx`@ zuAowtADQ;<`F;+;g3qc*3o5hiGjEZjcdIW{d2YU0$UU}>oe8U`gmU?J<4 zQT5quKyi3m$R7?GY?EszA(@**AM$3i$ zbl+d~cakVv{@OpL!>FvfY;kP&K4DN=+!ZaE4eK5pcJYeaN`dwhMLX*xIwlG#p z{aY9IxhrY`?4Sz!c`{%dFA&D@DcNz5uL@3W|zuB>w(<3~|@eF4a=d3_$71{fFX43!* zSlJN2Z5b}fvN*1PESma?k#y=V+aq@KbpBp>_o+6i_817dKCb9OQWV#jXoWqI*XLe& zJhHv-+1Yw-!gCUXvQyMHB>UZN*UjtGU?B^0h949IrQG!NxkIIld+=XOdUt5QTDU_% zsb$?}L3^Ugw<$RvEhMW@JX8XJqi|q6$xKB~$}m>oM}s$FxwpbH);#gQSIBp=`ckFd z<~f2)yd)5kt4lTN0~cA7=6zYEPhmcDt#yRq3na_kMHe| zvb2dpIpF~S8PT?hlTQVfEYB(Kdxw|z<1~U_aK7Da0qEa4G|wSuz*qYy2HuO2dsJK}FDWzR6=X(Z~{JxkXlIOIdJ<*&&EN^hSWSL9S@tpId zyz+aqP#jU{fN-&jad;a9|0&v0+q${xn76+b*8DjoyxLQ)#oNEDoe}n?4QRSLSkxYN z*thvfy*#ewI!5Rwgsxo*M%u}!Gx&1px#Xk%*IJGJK0xS(*clW9?PV4>+HfQ_s7Q^5;?EH69# z-PfgK9a+3_rwMiD*lWIMs2O`CwC(+emP!ofW$MTZ5h@~A4+ceL7bGDaSKM=OV+ z`Jy5MqP=6uMO&&GeeGn>IGAuKIEne-w*`A*<_q z>K$f;I3>a*mw@zLx(VP@#}ZYpw?l%L8CC}X-V=y**UVO4tcf`}MKDaKb!QWCz3Pj* zGLCrrVKg$yVop-&>?|9p3`EdPE!>>&f;GaZ`><(zcC`>%c*lFU=PtNYBmG87(j*ge zo#(@#s?d71(*&JvCX`T(n-N^#rrx^b6+~>SEXlfA1yq_&L@MQSke6!SD%~Dr1zEE1P7$=|t$Ar$k-K4<(73z|M-J={YEm$may zRaFMr(;se%gYX#ud_-GdTAsh|gY;OpbcPboX3N(luwz<>>lEZwO}C1nFL0&xsVt9_ zn@u}H_IGyRN@p046|acVjvAefIZ&a6daIv)z=d*Foyj0#kxvZ~arXYY#cDl@rvuCh zqC~uXkZViSH%kLXj&unQuaV>e?_tZo#8S>0YhRJd$E9A0jlEEGret(3Ze*%}wbN*4 zd$aN`{CJpjamZE}6dk&i4TVLD3WGQ~u$S5z`(GBfXRrB;!u2+f#JSZ8nvQ}C9wfxd z1YDd}1h{h{T2pyr(73$${09NH1+L1niTAIc->GmcYqXmMCy#k%@wYy8r~6J{{(=PI ziY7-Hm|X6OK>QHm`uPF94t1mjb!4%u0bi!W*gPHm=q!u5vBgwD$bd-Z@}gNR@N<@~ z#aIC_iHEuOs#zEHS+)#E*t!^-hnqdVfxc1?nWIM@Ro5{xBNVM)?7!dh%)%cL7^5cN zRiN$NO~(m29TOB>COG)?IrFE(N&dj_hl|(Dn zlxyuXUq*U#5ol)|1xI5m5rQ7D*S0kUjz|zDO;ka)@Y4T zjj}45Y^g$q9de4i!piCHJ^Bd^ZM(gxrO}Q_a6J>b`k?AOS}5vxP>InEoJUmE55{&+ zDl3bdMmPmoE_@|cqiTV!I^9xy^NsGE6Ls+nOpZW@?%UH^J1ENrO;d5hbn}w)QrD}- z-Icmy%l5Im2mg9vUtx!^zuIS|EqS z+314wgv19sdVKVmoQx~l(-Qonc7G3#W)gUQW*4H6CJwTkGg_VPhl1zRi)TX0=*zwM zk}yx7Uo&2KzFj01Z)X`cQE=sN%<><*6gYP@++F(P#~?vqhB$@YA$Akja?@Dv;RFjC zu?EUv!^0sc!N#<)1m!rqW>IQP%;l<8{zK0_+W8GIDNDQ|r$p7dZC@tQzh-f_?4}~i zxdlkUdym-@6OsyZ+Z#N%sJT{Px;aQ zngBmc)!iN0!iWDk)vDui1rF`BrwO!6t)gpcF|9!TV)C$KW3di-zLZI&Vh6v+A@ z^7ZK!fK#|AyQ$u&MJEBB4DOHXS?hoLykY;$0YGQLd_vkdEhf~xKJ#{pt7%uUyqh<7 ze`xnY{TS8tX0P3ZWv(##6To; z7qrZ@xq0`K3$UZqP z38M8wgjs7KO_M4an8>B?J-}xy0{lNm|XZpvZ_eyxxgO(TmeS zkc)=mP;D7j46w3I#Q>>%DUfcuhZKg@QfRI$X7jVSoW!MRBs&3(AQH6jluI2IcQ415 z7%yy-i^MAIEK_z1cz+`E?MK5Mq(1^Kdf%2EiYhO|62DA}SKdPapQ2H(CRvolU&%F; zWd;uo`p@XSKVw9x&RI@<^hmmy9yIpaFLim1z481t*Fv9eU_UCS5n}FGx0{1)70$T0 zsdU^{XDMuy0I?Z+AL_y>Jn~5)tIMBf*tk*@Mb3n#vIyGYN|7S60mm0BRj4~c*nVWw zd_8Qmbd8;2#hzUKdhM>zdiQ)9L=rq~lYBh%iI|Ojz%FsqN?~#rlw2+n>MwwmO<)X&(a%o|5xgP1bb+h5k7GxeI zAIz|TxwSR`3J{wX0FiH)dXQ#IYVBR_@=lhQcMyG4%lVO=cSH48ao3Zllvk6-H|l#_ zSCRnkxX%um$```IT9>AA5*HW~vA8JNad2jw%L^1j0khd?;og;Cc$(-CnN-PPRy(}D zYv^i=>>3&RF>s~&|>tCe*0csj!9iBhd%vFb_7lMa=PYmTjG+k2472r$IztNm`j z-Em#*3X#O(n;D;1bT>>Zd6l4s+ub4dTZIs-5)#(M^)kKst`o4;`s33uSX<7`RpGFXG(Puxq)BDv` z^^`B98Lxmj7;L9t@18s_RMYL9#&FtkZ2xw$`osgPJGvLa!xyf;KmVsRn z<$Z6UBh!F6w#0B@n^Yv$@^3cWMp}k^$9UUW7+>kb$M=$1uCG zWCp?QJDX5NOV2Xx(ekvoK3r6n|JRbd$inpANB0C5KLf;KaykN>i9p#=tpP357FW>O zg;WYDREr0ukALF@dH7J=yK3EiwgcIaHed6|;5}QnT9jyY(b_W-%VV3HZ!@}|KJQQa z6vb7ZYctG~HAT8swMA~rIYX~oG{xFi2oxTTvh+RFUlIRFlydVD4BmI^06_&Go#tq}9k( zh7z(FyNf=jET$wCY$X@hm55DaT39?^Vw)$9LxhJGSJ+~YE$k}$84U-ImKqygF)MKPrQ*s<%M3*eIr%1qol>-I8C6U zM5!T}6atevHm!4w3+T{)8nL!$OvOm(P?sv(plg|>J97GyXVu4$`Lq5K^ODyKR$*S*aHlXNMA z6}9hEQ%$0!CO6_si`3-r@19KUOgT=rNI9PWHh*b=zO<*dj+FlLnUAu&TH9880&0Fi zVKyPf!LZ&@T4wIt=wkf|S-fL!Z7{{@8SAPrZG+-cBZ9&+Ni;m}<6r)+K|szZw$)y3 z-Jseo17CB(h^bGZgYJmf`?uxBH;U(kmR?C4;^d8t-+twMPR=flaC?*6&W2tPAB0!W zOSL}9^MC1y5lOpqeP~TWGFjPrtBhClbKDM&5!47!uYlL_!!OPExPIva5Y3^D1NV#D z=Xx>qf@Gdi*!&W9;}p|v@)S)ucG z@MZ&DJ-=;7u6gP}#;4SR=vb$`{<|@&IeA@Y5^!vbH;ye#TqRu4Zi88GV8W?kskcIcahT|jYYTWc2XV4bi0_@&Hp1iSBP zE|}>m#K*qf^{6}cF>3cHaZOKC5`o*fw+`-xRB^k4I$d9hb2^T5fMCN{Wos4hC#%_d z-IY~k@%3)zW8YTHUUQvCt2Hv*;dFbteJ5z$n8l($PszvWA=d5;VazgO{Qb3J+C$WFw~n*LFN4G%GWe8P+0T5C76%KNFe`eRV^378(5?o1Nq>wm+aa>s z9e=rdTXwQxrwe1pd%xYO&AsEP6f31J>Q$r?QX+I}gx z6PnyO$wmmiLo^TJE=CHDOx;I3(}1JLUZEXAF^@NG09rjYq^;*?j2d#%ae@U_^DXK6 zGb_*c-Q0TrL6}nVc_YUs-D=b272NF)ikeIi*O@v^!3{j9@x1!HFS4HH4W$9v|1`VJ zF)qhPrKe{o4M`cg^UC0hPmEy|+)=A2Q{8b++%F)w8^W0U`etm2(L$+{KNTkugv#2< zTHjKrf2Ylr4s96J4od%-1$d=66&VwAz*=igApg3LE*YoZ8ggbGLqnKgCzN#S$EZd{ zSn}qO0&CmNwi%K6JE=ij-kXr2R~si$1$F~BaS)!HuvVOtyk7+;H0$WPA3wo`aw29D z5Iz*$z`LH+h?C5FUMQJX>{bGD~2w-$dK5|MgKW4(c^xCC}Zr|-%p^D~V) z1)~cx#EBw1riF?kJGkY76V7h7Aj;_b==@#SEpk-WUo{><#x~%x(i~7RiFIv$`8Xvb za{WY!&vAocdh5d4iO!=uvnEi%f~IVB|4BOH8)&L7Ar9KeabpqaK5;3Nn_ldmZf*We z%3||Ht%y85@T}|SMj;1?oeG(I)Zd5)t#5tH=onde+6mNIist$)+U>?|E!SvAawaOWAPLDvPLbkkQVO&u$so`I1p{Z;GR!nO` zH8xT^FMFep8*|&Q_{Vs9UxeFeQyuVd41-Bs4plB{H|#3O9&pQ^?Ya1Wn2#ebd*2-k z`7;;&>dHN)SMBe|5sb*?1aFUm0PT!WAUDP#x4`eiU>^W^#f`i3&hF7vhM_c;7>LGn zI)M0cen$awYxNnmTvIo6zfy~VsZ=k!j@>SK!q>wXCk>v+=El176-)Z(M#(+%)_DZv zqSa91qQGzf04${K_N`rp7^9Tq=9*vI z!eAy=JD~BBFu53@2CdeTRV8(B@{r`3IoY@Gh&=?s`mb(4P&>68B0|29fhR&(#aMbp zw76Z~1Xo>oMA}i0t*gU!hQa(xIU%OENWiz8!$f?)b#$D z{MYr5E)N;%uxV{OI;Ta;O^JhyI5VgdHBlJRmTPWsLwZbWs<7nCL>)iX5+0vkKI4pq zrk-|*g|c{ciRUTJjm0FzG8vt9HfoOM+H~il%EL>~a}aTme?m5U0^j&+3z@WIVl;a3 zV2$`bXJU3qz;Tbs95cz9ZDw}xnbiZtjA+6L%upeKXA;6S&Bq*r>(K#KnsH0IzgB{{ zzK~59(89^iRd*~o;?^Ya))Z+E7kW*yc#N9X%iW|zzb6PukPFCwywfo68BhDER)D(b z{f2;R&jkmmqJnOmEH?>u!FlR>1`PFUR?K#~drMInlnCxFu1hOUTHF1a{x3oj9i?5Q z2+ZsF;_N-?zws(`+vU+siUT?v7{QbLjxfz)-Sxg$21F=X5u0*efYzgKNa0wAH5zUm zUnD>DFELa!;7O1GgYfSpA0>`c3?F5CdAl^5fzr>fW<;7 z%9t&jT52BcN_T?Q+ZK}JkzHUaFd}bLQ@jd`XZi%O&Km>FG46hBpoKOstLErd-TQDG zt{tKK+xGYUWaY48(T0k1#)_I?ga9;hef1^z1>!!z<;ll<5fI962D&3VE-*a_&PWt=V8Tbc?rGP@)8RpK-2&AiBhrNZzv{DO~mN}ZIp4+ zHdA6z5g8gVNXK-XwYjRTs7=eK*;f`|I*yqnz$l)Y_U4~n2QbPj3;BCDJx}bR^gG9^ zjP>A%NLoRd&rq%ctx-KdEa~%YfLc@={*X#PL)JajH#^F)ANV@L=aR=?k1`5z4ay|> zo$9>buUqWyPjtZ9SsKgFU;Ixs(gGUhKRh`5i#F*9;_GyY*M~ESU~t9;m@Y2p$~uSg3Sf z(t8i6UuJb^6X#ls!HDU`cn+m>ojk&D2N)@Qfi))Ts6e*3!mN~nLH2#?XZ6=uTf@4I zvmMO9j4o4+ZbloDb0(8zg6F`-Mcq46;UB6ZysT24`?d1vkBSoR#jYosUE z_*ZG5uEJRZ50LPGgtSURIFN$ScjL(Ca%wS9G+@yO5YX zVF7+1VXVHo@U7p4J<{Ms$n3_kl7jSWRStT-eC*$CqA9ghrfeT#Dc7am<_cQ zwE3lMdfx(5hggciwn*+WMX0LNyU`vQZ;%jQwFo)HAC<@{Cy{j+qZmU86S7FKQ2U%* zUog>`kR4xM)fH54(qrZ!aQI~T5dEU*@sG`#;d=eLWuWCCl&`B8tk36Ep= zTL{kc*>O=$lO1tESx(_waDe~riVs;n4Su?~Dxz9Xc37&SwNW9KGjWoUFF-a(TZ*lt zzWR1ej$GqV`PA9CPN~kmODb3c(c+vNDb9xZHXjs6#a@w;p=O}tkz4W5O@*)Vj%Us^ z@J%=RYl)gj>af0B?uXxXhadvPQ*j6Si`<9c%nb-m;W!O&cZN!Ghfs|QEN(*2qySl) zreCwoiR>C$D)?5S{8JK}nh$N)$2v}*PFDM7acmDY8fk(cyuh174rV-@f(DW|DKJ2A zF?3}@7rzF8jX+N{+Z}%c;r}pE6!=b#i#DDtI!z~pg1BK|r&dLTu*v2SzN1=_s-(fT zod}NjKknzWiwS4DerEn0r}nu`;hlg|_PzxREQ*)8beZVkcM(kLk;gc@!=Y3kZysE0 zXM6gsvUk;{lq~5^vpBbsgTMTRD4Fbja6wA%)%7*MD+ApHo3Pfm#Cr(PZ&BDzWzW5 zO|ZP2L!Nk}ClLR4ZGNvj)O0G4wC_Lm#(=3s(epa`jh;}NBCD>hILcG?BBZTgCW`>G zc^3!?xh@dmWhWaeK9Qf-b-OiByu&q(Rg33A!%JWLw~8{-8SJ zsP+7QmAvcnrGBBf4~ZX&Y^7x;Yb5V8xs=Mr3PVJWVh^T<}F7t`fG1*)~2}%BGlY)+<>c3g{ zcvjz7s)!Pm6n=5QO+O~xu&nPGND8<{Zh}H0zg$ncsEuA4Bf_K!thtZNOoww#8>|F% zH#gL0iS!-up{Y7;;{t>tjW+ar0X4aw9f)J6J=j2e>|U(lZj?C5vWkJGPQ@TmjPios z1Ql?LdBL3a0U_SvvMR1Y!<$7e60GsB~DB50#=iO+}UTL2CKi7c zcj%K(VZNht9SgF{!$|SFaPwWnLDC33!Xu~X+ivC@sjqq$@5e&9@QhTXN5p%~#ZcTm zxjZHUhPH`q8|-=4&AcZkU<~Icb*~Hv+o6-sNMvLjwr*KuZ1JJ=nM|;pY*Y$z(UJq- ziwAVBNr>h}!{e!eGh+|;s|gU{dGf9681oS6L?$b&^VVxeSJ}$qGd7t$-_FsvhCEtI5j3J0J0H^xcP>TkHy&Yw@bZ{f%bqvkPl^hE+0FkVby@(}WMoPXv%PiWi1jFWsl2Z+-%jk#q0X|k?+;@50l z0ZjIA+@2OGv;tMbc3VruxkP||xo<*ebAv+muzgtklHk^h&Oy?Q*bRqh7i_-dZ$ zLx$v}pd`jKV~zqqOSe0jUQ6e8 zCka?EI*F(#C`L>p3T;rwcE)uF-FKl%$55n}=ctrvZ}7qcGF`ewt08~qj4!th!uku2 zJ#YI(C*>Nbcqb+4!YO8+ia9kVLCX##X3=P_o_sHeEW-EV09I=l;rQULN=?>LRGR}% zvnToWi@U=&s6J_euWeu4}=z2vj_yFj;0x&}j!>(e^Qa*pk}ywN#oMhj`{!dRwbj)%+_l z?s-sFqp!9@K?}hX87Eo90e9FCvD4l%P$6quQm8&QPg0l-L18&!oIu!KQR}>(z)NLP z<7?(vqc}93(Y=8nS~+rvki~XaPkWZwBSS?20SiZr3Nd;7m2W67;M_um<6TXi2bkoV zQz`M^1<5aKAJfrmqJzf1K@t6nD?38W-6ZD0IGfls_ubpwMhU!n2>zyNiNd)^-Y~VC z_O-Wh=_ixmTHL*wMyi%xa?N~4*LU?X4OP)noyi0t?_t{Fr9BH`hYXwVFG?B`cKMDK zBcJyBlbfm{lH4M`Y187R=qRE;N>#~&{AgmUdfsqO9QhR<6d(}!EIY87gjy~(G$>iA zSuWb{uT0R=XL9Sg-H8&=w`s8uE18KtykL}l`@CH3F_Po`n5euWB{=J$jbfhiXjrSw zL{^q72vNv5tiNtXrVDF5t=%X=AXi7j^fbYY{2?1S_k3>bfYtoAam6x;5ZoG^YTc{T z(dwj=9mGEKbT5^Q&VQ%6oo3Vqlo{5{1b8lvM3X435~_*}Xo8j>Q6Hb*20~xkDwyU4)3^Qs9OAT)5J98<2lmG7+LiG!4 zhb}OtbSdcRw9uuDyaw`>n+-SCr-d$zJuMx6h#B4I$NLbl8+M=?KR1Sk4== zCHU;O#<5Dc^Q34CpSZIlvr}3hxwoWWkq-tE(c&|;yeqq`ywKqC#YX-`(gMDAYK0XnkD;zeQ3#gD5bzegxiv0ES)9pJXMjCU3);h!BPt z$c>#5C@jRwNA|cPe@?1j%mKZyr4$M&tqs8`Rc_<7JqxC`QurCFOj6Ve1~}G*?hJ4NPu1iWiT21j~Aqum;mF$Bnb7BS(m^5{qRQ*K# z0$P$cX%)zK0q*WF15JdbdE#MkVvRX0Kytc+o+&YC2o|QRjUbg8JKocI+jhTaO%GT( z^Yr?2e2vodMj_BJ5=G%&%_odJSdB zdTrchjIhl-64USPAT6^i#1)lx&2T}HQdva6w+$90IrJD>d>3^8-OsD6%|=^gC1o$* zEBWx4kH^Butccy1ke!{X#?~5?RvvR=M@H27+Kpe6J&)mTz0aGg zC^3CY&a2nawqMa<9`>}1+Zlxdq17(UejV*BJ8~?ntJ6?F4OuO57h=sbQn9R2%HU>H zmqX=5&Z1`4qjvLr4ncEZWWEimU_z{VLKr*oSuD^>TVYO!wm~(b?REtfl$BIEH9rK5 zeiG~u?-q!-GIXPJC;tkPLuJ>Xt#P)33z3m@dv1L~eVGp6NqwSoK>;JQ#0gT3tQO6* z-R&3i^D97dV9omSD{sIhXz#h2exw74c`q&lXk{@KxE{cXkhVagj;x@VJfSw=UbA*? ze-qA+!ia_lF_9SoV)s%h>4uyj&O_Lm*w|k1sgmlRQUpH4#aG^q+MtFggQ47|Wj2;R z0}>T@QAquY#nsVwXZqvz+7HK`KKE$Fohx$phagkOgj}BuAi2NGRsD@oayVD2tzG7V zzcN(5QQ8byGSVHW)Tl$vrZJ*womv~oA3~Q3xA*OGtD~(R3?~I$wvxl#8o{wQGW0cr zkiNH@KMP@9?-kil6Z*3`CG~qI2EGwqJHIo+t%|~` zsfO=9(AkcRW1!KwOWUHTSz}q$FSYPD;olk2m#Iyq|bsIN4*(?lwo0!*Tvcfg|RaqU02++5z)nBQvujY`td7LSl5S*oy3Dln{r>5 zNTY9D(NJTq!3ioG?pL6|fZVh5i)BD>J_!y}-nWiZH&EN%P%wRI5u<{e|8<%BC7Q_{ z-i;H~y1S|vXgUqx4-`>Z*zvRX-Ea!1HxyG@Pd4y0D*mJN-LywiZ*;80C%;1Gd1_BV zQPQ#Cw5adJz?wh$z`nmL!G>&*KN>Zgxu_X}g3l*F)Fy(SH@tlk?3C1x6vi0O&Z@g& zO}=+pjuM|f_j73;Jwr5PgkR)tQy8Tz$jgmxP)5Dri`h}Pqb=4SX!EUL+kAZ7H#S{e z9?gxSDT5@HNdN>6l?rW>V!e8Qd*RL2Z2;QH`2dQV9OK-ExHYF}yXjVr<(fWBPx0n- zK+iF&KQsy=H{wGX=R0#d#`#R!7Ir^yh(o$6FEGa7?g8gQ-(2E+je)a!GeTfC+&FKT z{{=fkv0Hxko6XpJP|fnQ*VgL*RiQ6;Q_vP`C~We0i;3ZIT7N}RvHx`PXyR+1?_}U_ zbM%$%>MW;Vm!|;j0{C3a0k9!Etpoa;Gah=e-#@dzSial_cfgM61te$}ra!DV7BCqD zNep!$`#lsFW77~KnwHe+FwX0(Uuz0OeVJJsf%QiFj{}@-Wo=-Vli7f(5M7}OkhUMS z7G?hyr9D83QZQ7YW&m@%_<0w6Cj(&zlEuzvyv3HfaJFpwDs*X})vR9*r4&<-C9MHE z$4cg@t?&MRvKMB|ln@bzwbprPv#o3>UTfRXyi)hhH9ucNS=BEi;exZ&7Uq5Tuz;p;prEkr#?q*SJt2m z;NAo9Vb->(I7$k&-%eLqhU)Jf47sLTL1eCJaexX+!k9lQip6BN2I|lLDS7O;AKBau z!wOjQ=W9T$i6P29f+|4~s}jalbo6Dr>1e0rlQC+e-k!3m^}MX&?%v+^*h@(Y3iiWd z)TU{>qex68&fU!}yPTCOBy6AD3Q=A7WV3q9o{f-y^vai?Z3D7j`m=6sq8muMLB9#z zih;_2ih#}y5lEIJThsD>4`HuQgGnAZx2nheRUb|U@-G%Uh7kmznKD8PMWjPpgq#V%pepmwG@{SKtqK9D{ zy$rxn^O}?1)UP*f)oi9W`aNzkx|FJeAI|jFw27Op8K|PeDIskkcde*xTpe~jOYD*1 zZGq|aXK`p&_$PTx#d2yyn|SXHYK}CAdaUbHy35oJ+LwvhCt5$SCs;I>jzglL)$Y`T ze6+F#T+?L$SW=kgw10B=#fV)AU{IfBxT(0pFzu4<2T06Tf!(Prmd|fs&hljz2|;8mhF(T^&^&_xQ)L}#$UIx zs3!{_y4A@B{lu#L@H7Jx%b$k@|FfW_1KMk zm69Oz$2&jr`Xu#?=O8i>|1CTa)2 zcZ+OSZ2~>z7AS8rX{~g4t6oy6(qwp4nDX7puAdY7>&^cO-T!#=-+WiH4#EEYUjYBb z`d{<%r*ry5}uZF;=lnY0|RSkk(D4b?2iXz12*t(C=fbg@ilzvgK#^v+}z(ytExC|DeG z&A)|o9Z#oxcS@_+XXrvOi%Z*bnJ~;_%qCF^bMXXmdG8s9(<1=nyd)0Aikw%%N%^Xo z*zONQOOfEygB!0l_>b}iP*y0RVbWl=drg~BbjyM&{KvKmYZuFkYS6%XT^*WTj&Itz z!2ihO_0{UWuFs)7MPBd8J9tX@s8#X79F9k`NmgK|%?VG)aKVJLGDIkHZlMS4d-_s5=snr)Xj zE5iiQU%~_$w~~V|_+Sa^-LhkmgM}Kth1blq_~QP1X2}&<*`kfw@9Q_WXWPo z8Fn>oJBa#e`*T?*;Sd%EIE1w0S0?}`5!g?NPCY)+Be0g<6nAjicb##@cRj+&A<}HS zSu_VGv9stdd8iR0((L15T>O)e{h!7s@EWzTf`v8wR|_bcZi(0@72yP-yTjK8SY$c&G0>7_?f-db)`DWVG>QR|F7PDRh~NX zQ?*X{k7w-vO9={UsHt$f0Gco0U%mZY7ImcAIM3LB{cXgLlMWkD{jZP|jT`J&IvuV~ z9eHi}jKeQIwH-gTjGhdnsr|Ei;AialYZ;%eP)DBI3>E&#k+grTG*F06DG9z7D9NzoGA@ufC;cC9B7z1)@aPx^6%m zA0|Z|aFRpVwW!&!2!O|3%=4H zPv*_<_3i{tn10$30fC>IlJ;NgTu?SFP+mb z$s^-dPIStOY>{(3azQ6joZMIjU{MIhze9xTM!j-Re2p*+*t*V$1N$mb1E-x&&i+%< zSyHE3*V#O;@Y%O2P`fUvylVDqah8Ccfgw_iXC(u<=^4X0kd zYMNw5=i^eyZ$&F5FWP=%GRxUkck=P;O2#2(+l!;L#WQEBr=A=;yaNHMS)aoPAg_Nj z(eJqSTPcLnPgqx$Y(3d}vb%|<*pwlR=#*91F34=wZ;~;6**wtSzc1-19ckawR~CJ2h|h#1h?)w7Y2O(a2-geEYB7|-deC;WVfP^#18_) z@q^;K?H}~gsWIwFC|W8q1T97OZ!AnS4j{(RvOH>{#U*;HnJDgGZP*T@em<26w_fu% zWf@RQ_ur^Z-(Od3Rkfb{D@1?tT-jcjFeyGJ|F7s~Pnz!Ug$Wa@wcq{}>3c~&L zR7n4FGqUp6kbdt3gNkRp7MU3-z7H{P20 zyU^jM59w;|MRIPf3*YyU{&eL37j~K;gqEuQH_8J;=nR}&nwcb$XQ`1qze>%LW8Lbw zT=wb{R&gdqt>|wX>vod*w{FM1w0}}(`5}mT4xlpnoKD55|1D(tA8J^s>EbVst+f6f z%j_}w9F-~0oway=#XYv(+f>QOv=_mAH`{Wn7T-y?zF(Bn7s_`#oi?`nQSkKfSadwKXlRQ`{lhY8~N!h?VOtH^)5 zzk`hek6O;4Aqy%zfz(`2_ExM1YAN)HjZh$~xVAo?Vud$)yjZ)i^VqH;KhciaoWcIm zXnfEg9GM3*bcgMvt-YTnJXd{rlYhYDN-WI)N9^&y9D2GNy<@S_$hdNP6>*h|?$*k8 zkCxjEoL=ik0RjY{n4}E1yr2^u{J_SmG&waAB9?tJPef5{rQ-YKSk4eh@z{sAXjZ*OhFm0vf_owR;L z|IgNlpDm$~;iR>-q0;GJR`-t_5v)G^69WJFiojvIBZB`Adv6{Ob=&?AUx|_>$-Y+# zB_U*Aim1p^iL4<^*|N(R(qiAPlzkVH7_zUUY%LhFuM@HxjNM@7caE;^yZgSnM&H-# zd0x-=_j>%5_$=q=IFI9fypQEP&w`v26gyV-3F^0V*Ws@E{inMBTj6%q?-$^(tA76k zgS+Uri+;P#_ZN`yT`hKNC8{Cl~%KK`JQH z+PFOX`R-rEC`tMtsvDS!yth*)wE``;@M1yF<(&%1-nJl+aLO`%y<^7pB8W_O1^JIN z^nZyUt8Wy4(zY?Yy|IF}61VMNEA8p&vC*hpnS8vTrYgA#CDgaEI){)7>62*8Q{`Cv zz#Zy=sr9EDk8p?ekJziDIBvodqM}O9b-JHl_Cq`8!A^N52BBONZr$75{VnL@nk$<~2^{1|ep>9)5i@9>_;w>uW2?&k z-o2@@wd%E%$;nACr?vSZY3M4)%7e*in(0ocfo;v}h<>qeMu=jrguesIzsJa2{16_; zTs+S_j>@-0hO8aJB?j61M~2wXn#a1&4OYt2n)nF%c7!&VosT-Itu%9e%MtUbBTI*? zr`Qf9J-qIrcf1h)wEl`Q{({_AMM7WhYhhRF(yqA-jg_A^#{3%(Xn6@hAUx)?gw7L| zqPqRF_!ANApAFBspnILKHg3H!mr2Vz&A>&1*OjQ0zd#X5Ri?n6e~uHuoa|%FwbWg@ zrE2WeZ1NmcN}bi~*cArd(!!4G5(AzZ3UW~@{zy#8K)I`3d|X_GteiDUH0Nw*j$z+= zxroxlh%>E)?x~>pj@*q8jg5^O^&?G~%`vzB*afQb;`;rcM-x6X+8PTJC^pfy zoMm-@qwL@_+b6sIgQX2fUGIDOT^;Yn|Aoyp! z^iC%uWsPCv81VqMfS(rL+CP$KAN0BLYNgriW#k-CP%NS^f1o#mR>4i@$>B4v8P?F` zq7_G*hrHVB$Hi$lq?Wk2OYU3FxC(_JJaA9tX_Wg9_rYgb^cU_KH3-)TnaqSFRyA=U5L?p z4^Q^2DQ)544f*4no)RRKsy-}ZE1}gjk?9#3#$0`Ej%FQmQH$EGzFZR=s+(; z%)lVrw+C?^YT-ppRjyK!i;4>L&U=)*&UxPQ@Wb^)tz?YsU4Dw%(>kx`*j8sVD;PMw z3@=#AUyJd9H=^6dP*zi0J zW*>sVwDfFGOIWreGqGu@2e~ZPRBM-%X*dG+dTr`4Dkd)O&1^ufxbOxY#(N{<@CY}} zMO)L>0T$CQBitGlRCF`_rHi-n8d0jJmyw6fkP=R~&GpzCw{+KxZqJVER!aww@<135 z{Ad%toqKZyX{b26tO7|?B<5a4c>qsfHg}}E7&eqW-I-l3{)o&=+F8eEO>+z1)Yw?T zb8{0tb`$2F4lrTP&D{!ji?_=5Sih}bKo?SHYg|LUVSwdzxdGLZ<4kuRbmU<o37CcY6Mgd)9fmB!nDo8-4{qL;sroX%v^*)r2Jxf2MGx_#@s+OYLwk{ zbG)?R>rnYZLo8M`mr67a$n@N{OkbI}d|%S{Ymfpv-euaW-D_4Rt>WN{^P2B3bwu26 z;Bb}c{tyIHd;4HINv?BlrG`d+^DBdnfiT;mdLzem+0aG!1+K(Iwk*%c zDo=P_F4B>0Y9u$_k)4=DjFC-o8HghuvG~%iRhxmn;nh$sd0dmpK~79md)G-B7DzWR z*#w}72=Os5b6D`yBCZsOe zhFsJ`cC0eRb@t=OkEcH50nUrXR?5}LA;BER6XuYnPr89vwF077t)mWLquK-0aX9fa zy~V578f2_D(S5~ptK5zE`HYO|EiT0^IGWC&0a$D~JYmC~A70L*sv9_ZCR>BuEW>oh zAG`LjFH@n`aoX{DmFIw26dHg<(>7QL!5pcGiN+q#)gZ;f8pnFnLGao^h7mZ&a6tk? z!)744*k(OYjV>ztO$A@2uPJ(P+#&>a+YfEm5qcmLp~=M$+bU}i>I3)~vyG1?*fF9T z28ey$i z&s8^#?;T?~SE*yEP<-cF^~U*UY1EJBf(JL9*eFhx?wjj4;fgREpRJVgk{?E8c6Da? zA%s@;+nr!Q`MpbR~OQb*3aE8S52euXY?bOZuF(BDIYWBqg$g9pjmMrrGlP^~Gq* zTV!WKR?#Q$GP<2tPAey|cz4)eh05Qn|8ko2=97o3Pi_|3D=v**Fj>FJn8Qax8pAX% zH&Ag`QACd4J-kfuo?=_9&mZ1r4!FT>ZHg1vD(~9ZQ*bNXen193&K=!bXa-%Rh3F1W z1N6?mmCv*6OxNN2EZ_beVs544idthS(xOTOnL_WAtOUvw71i!*!JdJ+hEn~GW09?%}#g~Q)*O(eAhkYh7wt@|$ zJ)_GpGM5=DUdZ8?abe#$YZQWWSeIe^?Zi#>G&t&^BLmNe-kK?P2LfN@!9oraB?06m zii&gr{C7eCyAG{K4{6lcDEwb(43 zcqvi{`%0l^!iV3&hg&7YLry*2J!q5esGr~*0J?~^nx)F+kAURj^n%1VA%2nwZDal- zCel-f;j1FgV@6tQz0=@{M_AnW0D-`EAMVS-`AQ>W%IET5qeRpK*i zLd*eQIgKSzwi(LfEoWOA4j7jxT5u%MK)QDV~6fn zS?2$l5gr~MST%TzC!rtV<;8H1dCC&x0+<@S1K%^*8{y04OeUwhWPN%FR4s1X&9{j+ z{C8CHv+S6CK>#mtqe)UQ*L``)W|2)p)?cW4Jyj)CPLGSrc>_dYr~pY$wZ{C3gOvWT zXNpY59+(ufRGb}$loLeDEoEsr{Ndh%W9Qy{Y9jFO{npU~#Q1m6RfQxI>wwq>hv^(y+(3{)kk z>3DrsG6)JEnI{eP`(PzB%V&PEQR%-T^xHBZnKojN?tcR$wc)E{^kB3{%&Jp{nQNFU zv~Lh!TvGmCg}eKHk00;i`&x_&o!M3Df%vEi2LC)y-)jwW*S7%J!ly;hk-)tR5Zt?0 zI?nC;hOobuZ1r2fUQSawZZP?mGkZvBjot~WW#|_%(0h(Rz;Tf`p1VHuTNk<1=~t9*vCR(YBAeW_(gDo7~5u!1XEaYNBZ0xh#Foa zXmR%|XG&CSjI%?R%Q+eb**9{s(DJe(B8!+_U9;HzG@LT5T>HGzT;G#x8*myYViYUQ zwq!yT>OYTkk9V!e(wQY@1vlA6RN-W5$u%69 z(lynyY$9uKRhX>K4hUWek{{80vd5+Npk3x1y~*QH4oQb^-dMNCeR;JrDpQLWONIxQ z^C)dHLi|hdO&}q_`M}3a)fmqL!FrwqmDe#yE4|&%VnNQp%dv4W66)%=fJ~Hjoz-z~xQ0|UmN!2;p$np{!R;ukC83Ad_6-Vc zB$RUZZQUIfomG#_%G|f|fZ%)FJ23C2R*mfI7!Y|NEfP2d?VW&(FZ= zHE!Wbq-$ESZZPThqzI-^!FH}Z)D0M_-K9SVuk>bldbukl-8e`RrOO4kYmlrs6M|QO z$rRaDj)X{ass#x$1I>{P(!zr1Q_6RHoH?PM#ByaHK+-%+wJLsEJy90AlD;N{w_08} zMm6u+1vmCe!R8`xdWDsCs4CUry)(tN@hl+?W2%QYJTRCBE_`(DT1v7mK8E>C)tKo! zZW0E%Ko=v^uZ__n@=S{!m8+u?zEkc9v3pyECHggvP~)rwl`Xar%%c54u25K4yOEc~ z>={e~LF8$0<99*54gEeHlHUlL_QIQs7?UX_#bVj!N(1s|7bw}~JvXy3-gs2N3%n3# zcqK!v@2399G_M>j+)E$ZAits2aM~8DQ~e&jUO68MMpDO|_-3N#S+&#;-$yX`agqPvkjnL{{PAYWNT! zM_jm#45>@VJYvY;LvY78a~_TiKL*>m<_@Kk^Hj*lb>mazG}iy@UPU!jp}8>QhpX`@U`%8zOX6eAI&Uhk@$gL&%qqP6{nswC4)nfvi zxwfTrU5|hOr^ocTLL0bmYi)5ZTbcs5RGx~P3r(tDOj#MPdorGi+ZeXD^N_8ptnZ!;0k#meqc$a3Bs6sz?M9Vca_e++zK8;leQ<5I*|?fy zMS`(hZ^Bq^Asah5x|YO;V?3Mti%_Mc7M70L)`ld3WIUV2^QOJUg1_}a-VIv%~_n6`W7Cub*DlH;dP5LPxnGK)S0AC z^ZT_>#$Y@i6R?KoDqf|^4nWGfSOetA85Bl30>a#!Y}@p_`jZ*G4qhF zm&dnr7pkV30U&%M=jL`6&@`pZyNcn+`grbx4F(I5d$6@f``*rX}|uI#q;=kszmYtXAS$!vDQ?TImI@CJ+PUZh#RW^q8)$#A<2g1 zx()v&S#wGdfx~RbD|k7Pna78xDGtWT!LT+Rj`9PvEe*3vSJH@CQ}3y-2dQn)YRS&= z686Ie{qaL8+#lw3Wd@;B?U_2-W=|cQRtlE$^0Ti?5EDixAs)2SOAeFt-iyfx8JsMz zmDNgcsW76PHz{;rIy!(Diz~QX&B5B+PF>hYNiNcO-3jY2=TZg>AeQM2(*~t-encIy z$8IB*_j6E5xl%_gm;C+1cAxln9sB7wyK?-y1N`YXyV~=UuKXP-cD3gxUHQ4ZxQjiz z82%5cv1>E`Aedd7*|nK}P>o%i`3J%LFR+>F8~0j%O~cCsg{1qo9CdLbC7AkeF?f%T z*FA1)Eb6ySO-n}Dw-56KF$|wRh!Q@{BJzpF1>3$gn;wK#=KAzM?)>kl@n1=ePmG5k zeC7D&|2VYzSK(5@HPC|a!bXe!@6_f$f5WE_E}X$hLy3icgg3NY0Y!_OMHjVx^}3%Y zG07TS_;zD%W~Wd`fgf}#>Gd#PBvywfh{F3VxNujH|2RXtg8W(k{?6-@ti3beYM^?4 zq$zt(0rTzr)N9lgArN?~!lUCQ$$VIt9A6QW8 zt$!iQKmFjn57-`Stti8P!p1KUswD^{E<{2se%%f5^X;qzxcg0EUT;z}Bl_Ww$s3yw zzAc6&GIqZmog9}%&KeX_+zoAbsKLv#Po{d7l>GE#&_#cG@7ojq^o{=-8z@PWvhG`a zEB>$F{L>G)RA8DvKeRruU_N{@cE?8 zUA~Iy3F`n} z-MX^lI)F4_O3%OC9p7<5h179iAiIM6M_}C*12s(w83$=ZDelIve6%cGqhYrz^Yk=kGr2=iltopZ`Xj{{*95`tt*c|5Gl1q0%n> zA?n@#NAyR{`PI!dLIkAXOA0!vlLJ%wv!ri0d`wgCRL8xYKsgr*$9_JYd$;YZAViWx zm0Wb$^J|O|N%wumJzdU>E`cFh)nc;B2G=cVAyY9q0jqOIZs|c7*D_9#+{sA8q)e-_#P{Mhy-R7`c14M>{R1jVCYoTC8et5^B%ph+oQIcJ zzN4$z<=%_x+S=OK)TF5)UtlmVs+oij>3WmoOfz)1zt{LEX1GR{OQL}it0ak?dcFxQ zw7Ojf)-D*?3pigm`nAl3<&CJfd3pL=`CQd9IX@P?eR^Pt zTn4u`apk1iK1i8x%1^dx&zv1kV- z>dvP0hfn2lW$wyX4ZCtCbBy-z!)?2kK22we1cYAQl0Ovrj)D%%X!GY`e%=MFemrr& z0#dpJV&CJMR6FOJ9)Oh3?i2qJ;CAKsGgJ6mQf*gz{w9*2x%#g5>}t>76lB+C{w9)L zo7oX5aPm-BlAJzm#(fgwgRxJP(n*g!BQ<9v4>?q=tC+rykKGv9`cXxjqTqwPnznNy9%zFE@)7Q&q@$0I?YwztJA-D6 zW*2JW=c)fCk5*7tIIp?|Hb@M`C+VD*2bFh8Vvhm>CQ zj^>kp{)oTc_BF^kNECB@rf-oY0V;op|-ZG4?{AaN**OH1gb z4eLVBJdJ)%8`fsdzWgObAu~>$f1$K29u|*PyE0lBm*CD*nC~e$&} z&h&Pv)-SE<2aVq4{=`F%UG7iRymo_8;<4~cG5hrtGTai}^%toLzI!AAX@tG~+;qFY&fpL1s2q{2r&UL4b2 zvy6{#Xtu1f&vBSlcz%xZ^^z6#TyGzulixYjH$>_&T1%_4IY2cFPo!lcwwLDjV8oqK zv*ms*t$35r%@(1(%2B`8zkg%@l0Z_@kRNxI`M!k%BE#>AS~Y=iC?H9$3qrcdQI<_Y zxXqvvA>xV-UeuCbosh8MrMct(% z{E`FJ7BTNplppT;=Z26hxO2EV_gXz`Ya7Hn8^A!`;+&ig+{`D)@oL(Fo_eSwzRSMT z0bJA(^R19wSKRxWq+wUu96WAK;q=_7b7V>Tgk5k3y~yc{<41|=FZk-*G6fVF^<5ui z=t@sVh7^PbadrZ-Z|4uRJt3rYzQ$R2Sfl@5dy$5xaQdoGQ3k|ir-`{;N#?@`x%3Dg z6j4>5JUa3zs=qCD%jt8tsQ6Ap6(aKv-ovyWEZmvz!aUb%zf~Zx3KSnvFzV4^eBEn* zDmv8VdV!#_su@@&ccTkoXacG9?A;pmYPqL1vF1(&^!=VD@isizQ*#=mZJUyjqUmX ze5X4eRx6R7<9Vz8`8cox??R?|j%QYgy3|{@Gv`i(x25(h6ehlkGujYH_(n3ie7qQz z%_NY~+cI{O+!mQsgjeU+podk0cDI0WiKf;v@9>X9l4qFZNfOE~FKwenM8CXR)d zZeKScNdE{579Xkl+ak}O+7r~4#Jj19R_zNt@6lYX36Upp2})%_rhhuP)A!wZMoIBu zn(STwV8z2YThBnX`{w}!#QQ9lx}WzbUgaTZt&^Sp%Mmi5wU2JwayyL-bqbv$B>k> z8mx5H#nFq1mI$ZsSgi6n49QCxI+5pQXTf}GZ;;}T81bLbmX#iY=I7<4S4Q@~n>4eB z85i)U7&4);5OLxs41CXLSRHH8J73fG-nmns8z++^E7+^jRXcbVi2k46_x(@aEF{?s zq8<%F4{$eY6JfJzuWC^}#`&d6d<=hx%pObmR=<}rgEMBTv zPaRyO7hVyucN$E5#&lUD*4>viU+Qjs65_CZ9hJ!aCp)?CYAK3>8!hwBEMH@}SIX23 zcCG>Hnt97oXQNl5OAToA^v~KSE0ScyIegLrTVnV3of8+IgYr2IRlzo@%4w1unXECnC!DxbP@(;IRARU?r3*f7D~t zSVMNXoi0RnrF&dOWxPRG#kR|Y{v3M{^o+#)uhobu!s!v^1C@$KS%fhdo5HQw(#6^n z6ww&f88ZZI?chgG*s>f#VH@HWW6Sf6_ec)F;e*rUAEu>dmC+gs>Z_Jn<5C3o(KI+d zB?X1F_fb6mWF-mH*Z)%r)FeX6wKf>Sy0)-WFgIYXvYU;?A>Che)C~%qO?^G_K5A+c zVb#%=2@mek(`>3G9V zO_%fZuY}t~b!tKn7B&dxg<^^6Z?2z$Dj9X6zrR1G8Y@v8U3f12~cF4Cu(zS3?Yea{3FnUaKhV+KH97MJ9TRXvua?M6KKu zvCYz|Q%E}S%N~~R?Sd8?Tumpl_|8n#^1$5dSuDZUYzeYn4CI+#Q=#2f+y>>2T6gxd6^tI{C!IXk4qUV=W8`+vr2#tcpup9Fx9(K05oS z&#ze?dJ$N2i|sDd`x+ectgTPFTq+JY_vYS9H3vRS54{N%4FdnI@8PRC0E#`LU~5X> zK5=dv!EIl^(hR)*kqqDbb6@TQ9wuSMP0bCg$~PMQMoW($;^wZl^dkOay4Mh%JHGpl z1{ZGL7d8DVHN;)@kAACt?>~`IW0+pi_#J!d+Q7ybG9XnyHa3RylXWC)L)yzKzX{#s zU&yFi#X-sbo20rgf$mVLHOgeUKWUcqVbdXMcPfp>idv4?d`s8)E8X?03PttAVd! zS@N3uUL|@FnQUq0psjCwx^CCS2W3Nxg*=w3z4xM6Fnjgk7ZXGM#p24vI=kk+4`RmZ zw+Eq33I=h>>cMhyk+Y#??ME)9@`28;^q%q~K_Z;2Pyg^@u-eMxqnN0C#Xa~3CS15P zA-hPc@&0-GQ=4_2-7W~k2*+GE6VeGGbzF9Vu1{8HN)Iij1_KkP+b5KryuyADAPLv< zc_NPNHiI`KCF>V=PrhDb7siz(2@T`o`8N*|$qdxUOg<8~1rB6E@OMIQ7R+K^ z@Uc#?I?vsj*eqyMFTXAm=26~&bloc*KL?=ngfQZ<{#@W<13RmkRmsF(0U^PkbJJN`;Dq z@+;Es^B4jf`+gkPK4HmhhI>2#*FWuWwIcp#NnWs?(fq_)cF_0Tm9%M&Ze6 zK6mMRe^>ZdG{mBSEQoH?SYz2rhp&`$*iQ%?+HcDcw|E?@Y8NKqJdJKe z$%icBtHf?Dtp1NN?lnpIO?1-yBI@uKOe4cNkcEOqGGz9PK1<5B-J>|s0SOkc*hfBV zfgMXcLFS>9Znup55 zg<+$$*&%!>YxCJ8lyU69tHH~QRlHVZ&;@NF=z7Y8E~A=u;2&NTQn#_*Lnf~P9M|F^ z#^G)r)@;c=Yz(LII*D7r%cDFNn^r@`&u+GF46asLVcF4*BFGB63fZBxS!S@qC8B~Y zc6F1mP5F&CCXUlv!u9oks&KA9%+9-p`0L%Fzy0njpyh=xS+^?G7=fv0(+B~t?LHA{ zu#mYhfGTQuB_e?-YUMs?;DM=A4aH+Zy*9@t799sXUFQb3s%_uYKG-%x=kA(Zg*;_WtRja@^Fs0ZmU`676b4u8djiQFM(aZY{vr)9=r%a6}>zQOU$Y@=sWflwL z7msE91$U;uZCHm1oUww3@kNZ;ZEwSJmw}Ta-<+enQN4bDH}z?I&+Dtv%vq6-e74ni0A@5+QDhS1NO0C((XiO%#?eS)Ts3#7 z%mS*h%t*@f%jGm^JD2w;X-?VHYkA$-kNWZ_GVIVpZxSBHJW6XJ}79z&NNbEHRm zDrezTEIwcHB;>AAN$OY#-4Izt2H$38mNkq`8_NFkcoSckpAPMwhG z>FsHa?8%=M0gCFeZ6pJ-_QYDgk|IE(nchNhFq@aZd+f2tegoHT$840tl#*+;26X)w zw`XBG*Y_^7>IIT+%UVYk640|JJMYY|Pl+!8B%^VBE(O%8OD<8`ky-o-I>~ACF{~lZ}^lJ7sC4J*0 zN0$S-u#2-FlYYVufWh&8Ryh}##ns}^wT#rG*b>`T^|1;BfrR1W`U=oCKx*H%rPgQL za*Rns22<-FsZ#H)0d)98mFGMSXx#mn=l;riO{QKiYq9wkQ^A!iE4Wdh?(|zWHFECnT+Y2 zMjiF`Wjl+dS1qMY`gFs_0pkI*jPZ*$Siig+!-DV!vv2~Tmq&7Vcn zBi1D6olL3+RjhezI<(4u460g`Y9f2u;? z?NB(v(VL9D3q1n7YGq||@)+wqwoXn&Ir4K{aqc$9!kyh1Vv zblf=+G#z)*wN_PnW)D~~s%o%B6H0xZYx{{^=hPg(4?5p2f!JmvExthCw;u_(x_n&p z$}9-)cp1b_JA?4=WO3+zyG0+LHKvI~gV!}2oUgazxtf(m=TZPdceX(&C)k0GNG{fU z4``pHdMM*_bOqh#3Ts@v9$h*(Mok$FeVYtu|4Q+La{(+lULXWW;7|Cll6NV0Tm6nf z#ij>=8#US{&bOf4#EkYf1oUzmGiZ24qihuCE>eyd_QosGAMsEXKR34yP7P3R>W5yg zJ!mnUcHu8dY4+Pd|AKVo&63l)FG?@>bKgZ{*TFBG^oR_&!Uqln%e%y&&T->{@p>D9 z6*pKT*x2MdZmn{UcyRYx@X8@4 zOQT~4|MX{|?D);3`1!AR$?Ifp>sju@&OUJ1;C9M_BL@m>1p+K!N{n1u8E{)Ad^JGox=|KJTYVWXG<5SzEsfVn6i}Y6=8hplr*n zdBqU{YDXq_5IjlZPh;0RvthNU=2^sOgubV_)f+hKufVSBw`pD$xmsn?&}Z+}M+d)Z z+2aJI@;=7ZXUz%*4?os%Vq*6y#eUX$HNRwA0p&Cn!_>Ory2>#UUZdLtNp167GV^$7 z3aq4WxL&rnRFdu$!3w?HRB!e){A&a?8xzFV1A6NbswbCby$+)Tn)k_^Xbwf!@;JH! zy18jhf8r&4bPcaUFZ$8|oO@xJxMhVY@_}#RnGS9p_Idy_C@}Ve$E<~ytbS--&LW)p zk6XaPWh-G}*4@YeX`dMAQpJb1} z9<*4|tUF$}ZY7nMuAW-*b$_bcS8?g^?+Kqae*q8Hx&tT%n#wc1v$HiArjBBz8G%+g zP63!~9WV;1F$cBHiVoUU&vgK=p@g$T&s23hwNW=UoC~bt{8Bku&t@kxH8AJ7inI0T ze9$EJQu6BexUNO68H>ufIT9P2-P~A_&I6LOi!b65^u`LxjU)$V2cvoxfPZ=*txuT3%EeWVqW&cE4 z!l@;$e$}fPdh&P~WzSodOH2*xi_+jLH%>z?Q3k_9CG5a47zi%JVEQW)b-x=k^M+ct zF+P%W_>I0Rn-|xHF!z8(sIY6@HWOz@P<5W@fq?h#R!$_(I%NR{toV^SlVz> zqfQ&pJ3fJ+22$4~(^>?w$xyFGTYCb@Q(h@`xA)Rm0_hKsO_twC?WzOW%Tj7lEet7|N^QjIMLH7O%A zPF~x5FMh=`VHzL}yA>e{S)2)n5}Wnspinrk-70N5;M$veFG(m8fgq5p*ALX}^h}O5jvF5AErvm=Q9L67jnA5vjb)MB6y$ z&RdoX~MR&s^{|{k#$|y4O~WF=oq=Lk4Bi0%hP1al2!EzBuYA`jh39ZE$O9 z)X+P9`my!0K!M_oLWVsX-JjH>h-QcE4*&o>3NwGtZ(-dt$YMX_O*))Sr6DbI!=ti} z%-3tx(ST&d-eAMLh*$utM;qmEzNW^MZjce}9oll zq%=txaWUCOJ8M-Kd#|a^XDAETd^UTYN)x;!J?AklE#Eo!%3V+ZB)0>nLWxwos|yH; zDYx_U^2G~`FE98cX36+|Jm~f5WX4O9=ij`#o*XjP$z6@H%2`idDmRk>qL6`_rxO(g zL)3zfdSh?6aWG|K)b{vP1uK^#+@x!0l#kW~w;F+C>~&;$>aZNzb7^EVW_Pu=h^;q? zN>IS+`9y@=P}5wbruJeSk(Z1?D8SIBH~wt2vE zIPY}@<%e%WwDje2x#u9&dZkxF5meib76yww0S3ounv>tqEwb_Dc+RHHn}x2_Eti5U z-aOMlLM@aCuiZn!eF&1BH1t*os!C(Kk&0Ym^l7hR7GOAAA=sO!BF)@HEKB(P(W1v& zdcgsjN@k}BQ!R9658Qyg%QJh?TD7uXRUPga5oBfK;7+iLMUd%UkLwrX+#@NQPq{OpKR*|H{)~X`2a)7?K$4{a)gz1gqsHUg(SyQ~Yh$ z0)`2Vc+E6l8bn2<++B5}KN%$$nkcSJ^i1;a?+d030`$B$nFoS>wMw{mI%Vrt0b7bBF)z0LF<{@vbF6XKZLgGbuT{2sO7)75+v*BM47Shv zK=7w}Ur@?TyAWg!xpvzz|Kr{0c2cr)6tJpiZFFi0%8{ot*an!}^e%&{VD0$OKC*94 zk7G@*@NX9}4kTvj^it3;(eu6Nawz+nK5_5F9?8nXiN0*0;uLHfbXS1TV-T63@aKL? z(6DgKF}ma9!0>y#U&P=CP3+nQr?tnexK~aMSVF++olLgr?Fq3TX*#@ZH^{?`Tp*P| zBVb!`l=R#3p-=V9*T8=>ZQdLus8viBvO{quN_dQx@N#!fn^mf#pn{@#uD%7R6?n`t z;oTbv<11Tpy*P*Etnpf^LAGpA*(xX*N!@}&;C?PnqQu<6UmEnVI$__KkQD_@Af;V^ zOXC|hih3_T>=j1jneL37orQmbOmFLxf4G?}lS=sp`*hj4+4Wcf^ry8gm)2Q&baN{w zGrAq(>Q~f;2`U+)aVh)gyge6M)xc->zqs3+*=|+wZAo-7qfYztB%^Cx+)W_cEDHB3 zF;EHY4T(a&-md-Cj8AF1)-0xN=f=(ya%2CVnkD{07TyPNX&{HAVa=j+}4ey<_Wu7KsVmR zjq5RnbqUOclnM|kT#+p0{UTsMGAANdds$RB4Qh?q(c&osXGap^-%p~cGefyTi})QE z2mNG^(J>Jg4uV6`H@&MS(b4VSuD~umZwtQ?o6f|a5j)5ku76FzNbtaTo&`|Se0?)h zRZs|>6s*3KOfPQu7I6rSSCz_e{!ftGT&e9n z6YPR-WHsi<8&}%6Hr9JKS*1?V&TmC5+PAHbUGBL*CBZ`}P1L6$ZUPI5zb`TR#(ty!*BgWC2+eqYv`o!R0MdJ(H>-K6M%V( z;`-VMU`1`J2aPB4`q?NboGWjLhX!Ui)KO*5AAxBrWt#ekmLh^yLQ_Wvm*!`j9uup7 ze)kBkxCxyGbZ4n_RAx3(VJ94II$B~=9~(D2Ed=?c!PD>W40R0KgutWz>pJa*DUZ>q zrDqcpBJs^3fr~0Grs_Kt`2XpEZYnvNglZsxSstClfPddK!R zR)S&=K{AtuY@^9=+O;{KYgK)5qHROscT6wrjJ|)62!MtO8;iOn93?V)SghNS@q<26L&VCSJ$b-&lpL zmy`xFDY3WuKSt|vCHG5|7N1)ZE|S|>xFOp$_31`|c)7E^TG4KkEoLGdV`Jf^S9k8D z;1g)McD^RV)IM?c^n8dtZcY8o(%rLbgK8OEjkQm9MzuYJiM{l>QYe4Siz$y=1amFf zQbh&TJ!vh{jB59n+;R6-(tU>syaa!zbF12~l8;W1w#>_E;ftEeoPT#mbji+g6MCp% zMMez|7W3lCpG^$u4z(Q4dQv6Fi3@}@SW2xAsHyEN1?EeHELN=907A+PjXydJ4|3@b znht!D$SRHy*E@A@f-_R(t9aS@-*EN!36++YFAy@l4Hk!FWQV!@SDryuW9*S{=3DKD zDj-bC(5nUgu`I_tYAI6(o_X5uY<$k7=ccI2M_y$#aBQS-ls3i3+M`oj2N}??Ryihg zFQn_DY8|C(fXg@p#f&b1&;+~qLi#x1A%U5Y_uH&4m9AS2@Ad9{(w^_@RGs$5-lgyo zJd$zZy%Yc)=l+hn@XP8NP|(-84EjfUK&~K!vFg~ zKmakr$P4&)m5~=WFD=Ckb_%t#qiD@!PxW4H-9E%tNNSH)64yXPHu{Mw0hz60kEQBI z#c>WqM9;GWpM3CmanKb7_0W6eYAy!}vA)kjsr$kE#Z1L@eY7JEwlhLXlaBUOoa&`Z zfyu=$-GA8?j^BWcgNDspL&Ta^zB6mqLl6)X(pH}6txT;H>Md-&!oj4Z0@9t~tyR}v zU*Fn!9mwQAzv^ zLTU4MnYJ(jB2W0q!GWkVOk)_evd04 z5t?d9`#l!0I{B4m$*MFv)!@c<#^!k+A|f30hL&cB8$Yi|@Su3Z0UTGkK>X$-pc0Rk zO5GPG+o`t6eUtU%H{N3zyon@M2adqI9Q1iBUx6lJCi_OPiNR>lHVF?t0C5GfZ&R?RyH(D#IS(+2RaY5W1cZ4p8s|7`o*N0~jelDvl8o)K)=+6CQk9S*3m3F%CXn@az2nLP`zH_N| zhz2wVO<<)PP|+7G5!$NX17EpR(2NeFD}lm%d`Eyj}edZ)i;w_1P(q~-WQ|9@1vBgoU~SDNA$2|{^*dyWYjbRwhx;NGwRppl(H~I z0nIn!cItxNLvs1{t4BU|p?Nr&UXHe;KKA`1y;u7T5?8;_Gz5<;Z)8Kdl=>#!l>5V~ z+`ofAQ4JJ5B2=q?ph~!N9S8brI4wBDYo9JfJi#-g!}D$R&L-5uObZrMWi5Q=zQDYS zYGluBZx|R(QlWN$$hpsq+sg&%|q40~h;UjjRJ&{w-hMzG`e^b|5uO6L`^ zG5#t|QC9BUHAt0>4v2A-y~f9Rq>|;`id%N+C8u)Y4+96dZ6(Yv9?G`>pVI06cAJP7 zs)uU{sDJk|>L8=Y`@ByXbP=fJYx78D5Hg%K>jtvCWqs~IA3)H$ntir94y0q$`HF+D zfG+zV&PldGQ+DtyFbq}d^`!~OO<_gsJ^wlXl}8XodXZWomCbSpiWXhw^h{Dcpqo;} z{^*Wbi`xp`Rj8Kv1l`Y>(aQ#Oc{g z;GVvR6x~Df>b;)QR)@o02U&PKxQptWr%-|xJhI$=DGHEf39vc)k&NJ)S-*@=k$oNL z&Dxf4rEPdK)1k07%G;&RqF_1*w>c7`AxYoq$s##a%YD5@Nu9=A7EFV3mUd$ppZsC; z{x-qrk%P1wxZml-1GCNF6- zm%`&p-mcUJY3z_^B~3p?_(*|0*dD5>$!J}43!Q~pH5;o%HTh2T!Mlne*Gr34$3@l` zkGVMT7>O+PvpnX9MD5|;cDcl`9LqS7pEOh~5-xwr6n}~i&fu;@<#EpffaOfvZ^luH zWYl&+>lyDK&SK)o`wQ9LIN>T-MsQtzTygeScQ)pUTLdhC*YyoHm;~B3$^R`)ap6AJW>_?9JjXMVTrw}hjbenX4dE01t19hnX zifn5_K}}Ov-Lhk9rK|6T0bxm`w*}cbONM4KX)`)~oxip$Dzo^o)_EeMq1e)*BL88< zV9y7Rk;7qaBfWz81Gfkc`%jOY!Ja;j8c-Dh(O{z|i@7Dp-{t=)UC(<2zI|II@TP;F z&#T~!SejYKt0I-Kp+}I=sOeemkdo80P^$vURM?T;j#fD?G=FOmr!gI`t8BY^Kq82| zo>I|-oI~2H_AjkL?%IC$;88HZeZ6Vt$q3zmoKAgIMZpi_2KP0jwSw5T)i&NANyzJolyULN+#%?eyVd*Y z)c6GT2#GIAWq%K1PnCb|`O)wOc7ob|$YF3<+E~7U ze0c=adNMiVVX5)#HZM$lXzCVGj8}yfj}UD~AYinDDv2VK z=*z+kc+gsLYjd#6gM#GHB_H4MiyILj)9^brg#+z;5DB$hanA>r3Q&O&RoLV?ZkS=6 z-Tz_lJ%FN2n|5JEP!y32DiRbCkSs_}N)kyTA~~vnk|j!XRI&s`l9CaSAaTf1f`~|x zFgQd(GBbeWFmUc?eD|E)eZQUYt2%F;@BfRct=e*UVn2O%U)}fB-HMey@MwAcNm7cX z7`&l1`LsT>m#-{I^Uxhi_29J?OEON8{H^+x}}DYw@ynk&A#gXv|c*U#R$G_Q_VNEAl&RlC+Fb>7na-pS7tw_8YopB zhBnL`hE=LA>rJHkEj93q`a{@H_m=}TeZe5Kt*(wRFaXfdO-ft+lJ9E+CkUge+Af@D zW6fYIM_JWcKB`{RmnbKS0&TkNLAu(SMpQ^m?F)QG!Jj_WO9*KpCarm};g38B2grjY z_P7XF_upiqoN($MkjQLlnNhM?ze~%R$5zxEq5Cc_;md7x^JEa!~3IUpI>1l?2TJ)K}rFF%$%`1~5!LRW`-uD&fuN5Ec+3vwUOkj?;%0%0VE{H$x$k*aY~{vcinFEkKUKk@Sk^ne(uxMT3=` zV3j{?i|p0!5W`s~^8de4^s>oJXg z&PaA9g7_WKe(}1-{m0ywCN2oRubaQKgz_y~rY0ZFpLOUqoGdTs^5C&_GD^ogmaxyr zB(<4lH*tE~L2_-x72$~n+8dR^%TzU;`FTf$MxsA62KhJ=Jlz46!K?U6IT~LAg%e=V% z`3-FIGn&8eiEQmo2Vs1SC46?COXY@a_;w95p$>KB2Dx~_=Tbl~fo56M+}KoR7vpJE zSC=i*dyltM2~?=BXrkZPg;*q@Zy*yz1XPaaYRh@JOrlHW=MgE@XOXJ0a|6CL7kIqw z;E91Qwe2C9@4lbvG8zdKhjwaU8pPJNp=Pfyi2iG*V1@AIz4OYiuucTLxfXxILHbIw6+1?gZSURr$f?&R~UkaO;c+FUE|Vo zVBg@=;&_)g8#2r1zO%~8(pSs9bI87NlQ>U(I7#VY3^qr6hkWtK7XSQL!ATvche3iu z&2!VphwjHK?}i2ga3|k1I8p&fYky?8<3EBDbPccdb-0Qd^fesns>Ep`vwd8iCAj9C46Ha_J(@rs0%`@_`YD`gqNAW|1L&TsA+&=7!yY$PzRSI{-^zH}&e!O`B8IuFhM(sl) z!bGMzX40jlFCuK_zr8Iy-=4Gn0ore^v=FQ2p`yaylK3!oBbq99HG!faM5W4UdPT(_ zY}MYi{f%?4lR$;;!Ubhd|Z;z%PdiPOwB{7-6NlzJRdc#nU7t?56ccf8=E`Zr>u611EkG97T;@d z4L-sfu(ld|;;Tf>%U^5=+!_KtFi@`#I?H?QIoqECF!$k1p(QWMYb>W*mg=@sC7G8; zr_Qa7T>70PDl-g_G`<%4IDAAdoLt(YL=AO$3j%5tt!QY-n?wrK`>tI+J$G4Iw3{iR z-4{c0T%|C-Hu(G~*q2J4N||pJb|KMC$!*)idF3jlkkKg&G$^&Mn-qXWnK3X#FQ9J(jHlgH zix8lsyxBIp-3n3N1P=jj%*YXSh$sV6(DOCZHjhATT@}wZ0JuFUbVw{WXaSQEO<&!k z>AU;XBXedjD>1rR*PW{2M)TftSi))4=#4|Cp)oy#*N=e>5G7S8{)9}W(LFi|K!Z_> z?&;Cy1mP+aw%!C*>eX9sJwTM|zAp(1unMy$HGrXn8$6JgQ7bK^n$!Tq8R!fWU?nTi zdU`vb0~^kDgcut+ZoHjJ^r6ONliaYk2sID-S0A@Mr|GX zz~M7|a((X++(X`@`IT4sZ*)xO$`3EE)pd1MIlkBl$a-rmUFefGJqXwF`gQs2V<(5H zP!*O&(3;~D274(FZA%K5Nm^E`?>?+p&g2s&3Ga3+iln^+_(Mnds^UpNltwpTNpXmv z{9(l`$nPK2u?s%-17a~b(UVFsGiN|Yf!v6su>SqC+e8m1oOC;LX#|fy&~lU(KuV^> zlcP>-51_`UTvNO*BemD|a%%L(b}Y3tp3*^SjxTACji;v`>Wi1ZGl1e$wo)G+Htr1Y zi$^W{qoHl;81Vz5lCJv5ZK8?KGsnOK3}w3HE)heo7;h@z^a7}-1=tX71;wDPLXA%8w4WloHP!ECouJLA z7-++5yAHrkfqLGUgIPTI)b;>u2GoD4OikJ1iWjgqG&v07)UWSK)&1r1U-bgG>Q3}e zilw!Tlxkrl%^uBKC~jK`*%Lhzo9;tu{KHBP3oTu00WLal=dM0Q{eY6M*%y)Tax=Yi z18)y$7H5UsNg2AJ*SjFv75aPm4))BBa-i6lf|GbD-gfg-OHawOa z<$P{h@NxP=zTaTnQo>4T1$R_7s>)dv(tm?p%$482=$3li)!kqvI@Lg=!OAwybff}* z65=+6<((@HBxdb%+Og|gYCd9Omp z?D0X1R4*wcU8+`IhP?P%lHagLTWbEGQx(3$4281g};%0~_*;;iF^*y>OikhCw{stBedJ>#K__kv(zz2=n$ z8_K!bi)Kt}jdRJt4`AJ68v%M;&Th_xKFKa)$qo|poSYA$#qg5r3C+(!Pd83UG8i9_ zb~Q1FDBIb~hg)cVaZqGw2HCP_B<}JXugDHvq=)Ks4PQ!AQ{bGMdZVB3@D1^$a1kTz zU{U-}ahei(rJH7Lm0(+W`m3CM+!Md`9<;PrXh-hvd@$0Za6q!mYJ9Eeb-jLyYCTl5 z(_VMbnD?EVOo}>wBo6pxLV#&0P%umd-M^KhD$~UbJOcgra2^6Jo#`?kj^F5AOHw5w z&14gNuGg8*TjhfI5*j=nVO0=$A}=?-N*2|B7IIlQHz+&9W!@Y+o%{Tj-E$k$;QtlI=VC5~Uo-fPebXPbmVmca9!NASZI%~Og49;` zJnvw)8c8J`7eMAmJ2oo+6oy%lP7L^sD2tRB{yxdnBIl8|*-$NI!McL@We2p(JNK&% z(I?Iv-`UxA^9h5EZw+L~jn=H1oB<7L@Q;3hT_8l>?!57Svq_eAcQL?+2l=SWn@7(J z?ZL9f)-{`Vhh-6M`Q`yz=<{)H#qDLiox1O=M}{}>6R!k0Z+Hz|r8i~@QL-^GH4|{EeNBc#00dc;vHeW zD$sC_IJWElAU`e+<;M#_Iw1D5F9XPrGl2Z~8C_;=HSI%N29lR5Ni4X+IYHaS=fc<5 zSpa9~MWzAJxkp3EZI^mq0DQ7??P=S5%9iE{bD_={hCMlhy+|7LH-;&!(L~657_ORs znu7;OUqa4w`Oydro&i~#wqU$^&wjqM?};DpGsRUJD#USz%!ER|`PD3urBzcl#eh9| z15L@655IerpmFJxAvR=X)>EVvh{y9j7Ka6`4Iw2{&v*;*xOcJBRruk3o|t%us^QSKoPxOur}8uK(QQnmLfOc+lVC|kY|!`PSB;p5)m=^R(0*8P zq~+@i*3UDc*01h|g8HfEv4;*v2!A*o5o)1srUZbn7o?)X47&}UxtOm40%`UNp4MMHG#T~szO_I-H zeL3AXsizmfvk}O@TL!_`vcBcP%iz|Ab0yy!YN!PTzdR6uZeeLu$Gg(@hMu20d=A8H zYTH3VfRy`2Sa@t6^vjwL3F!pQwroMOts*+;{ZzpI4aWPFsUXY%lw>L{yYzy?R-nVG z0Cj43FrbJA999%R@t~SF*9EqW$4o-`zH~6LNs!xC0-s5hG0_4&3$iK8@p{#Nq1JYj zD(9{#8>kb&hGl7B3AK#}+)kbz)VWqa;v1F3Z^NZvJhXymD4vrAm#`xHEY|}|r1UV( zw+UVPp43t__g4FyMj5A|f`0?e=v-xV~SGF3inYGuyCwAHUw)%s231f?r+jqQi zdM9kMftwr)!EgDkD|$GRdWEvwt*jsx?K1QU2lSyX+oJl* zYWP!jz?l>$eYd-V${^GA(W(Phz9VQY$x`cJ{fL}CYPGFw^h1|aS-o#_Q@KU1{V)gq zCj$@yQ~^o!VNzxLjA&TmXh8DYhz2Fwl^Y^7J6Bb<=$~Q}xRz;|sjbyH%0bF;iXY!K z0UQ_rR%^4$^Aj?WVJYk6cNW?9Fsfk+I%#HPd!uTz!aRcNH&RYXXJI8Yf)ZSPUJH## zWAXy+^JCr5a)aJv69k4`5X(&XYOiyS2mgl?WbQ0^;-|>kSH)@O6CN-{>?JO?*(Rsh ztF1P8nF3qdgnMjJ2WH_?VviLuaYfpX`Rsuqm5>&vZ3MX?$291-?0Ave`c@nb+N-8n&>bX#*XIpZ~ zdjqvn8^ted{*SAmvxJWR_&lT0=d{|Z?X%!VN^g650_l)pNtC*U2;VS3 z2*-DBb@Dy_&J6_ekp^m1xOLg8?^e?TBf_l<%nREkbRKXitzB+`QhK$bJtdK?GmwP9SqSK?3&0Un&%Pf1 z8C5#3yP9&8H%2$Dk#Ko)scZ^Wylq6;%=@nCrhi`8XoMA8d(e1%aescpY&MSzLM?%= zne1OM9+bR9Md^uOrkacWmv^)X>>dNz8Ctv0OjR!CJhpVlJIWx}s4V;uegR6C^b&%` z$8Pk4F#zg-B7raTsg;4?xf`8qtqXwnSelGM%7Ofnd&-BRA$ZLDj2ZEYi(O5Aa@MrT z0+jJavA+o|LHJ-5xSEg<(00zrJVld;^eFyuiJi}6z;{5OCRP+W@B;APXmkYmXk_sl zQJagF?`j^7y+lUc8o7cAF4jRebf+}iV48h2;v4?SU~=L zP-j^_&{R5|X=dAN|Ry9<2kMET}r+23h6e~7?_)3Tq=%DX+>dGA)E^eGet zFmtDePt$ozAX`)4D-Ak%H{LY%dQo-@e?e4?ugvP(CneRp+!t=qP)l6mFQ8ga^f2DZ zsi94|D79e;?=^A_C24=Y)^90IWph?GI-rs376eH8*0addTyEOt<|(VhLrwSLMxt1CoAY{6){}KMJ# zpszmR54c>6B1n9ORU#KIx6F7i>`CNG0Vod|)_2_Tb8=LLGApi*ds9%udd6Q3>tlo= zDAvb{g@E#&#w+eu;NtCX*C*m@M6asrG15W}s9?6l8@@I4+dclelMwl9JDht+Cp8ZJ zQ7U%A4G^g%c(qH7LDJkO?2EkwbiI&S$5pqr+=O@;$mSIdut`! z;ZlS^Txys|FejZw*Zp*<+LM?;X=Jm&YUxekyub)`qZxuJ+<`6hT$6-IkXq$1IBnwy z*VaBF;ATkgB_)LvNI}J3*{i^h!Y^QvNAX+wRE!>cTLG~1-lVE-Z{2oUEVRs!_t=KV zmnY)ZR{$$Naps4YRw}rQiz;lEgZ4`C2lfQK&-`qIt;M<- zU&aFX7=4g;?m+dq*qW9@Ek@dHFoSA3YT%bOchjF0hym&7;OK70^7qw7w}9a$_sT^( zUo3vG1gT8v1APz4Q=&t2sKkM$*17T_rvl8 zj39KKp&0C}V^0eP9;E$JY@m2%g8eA|v>mx+Bw#?TxZE-}{Eq)X7M&XX`}Rn$H;1qcj*|vN`aj{9xs@i_iRIPh=iXU_^~s2A!G|8{)>7 z=&m@|>BlB`=Cn?RT%|I6K)&)K5|M&Yguh8?`&oQe%tsd9R&+*g1aCA`=SGkQ3U)*8 z@0!8ErS##xma7QYbN06ItkKcLIkpT5Bc^p}X{2MS)&e$Xi!+vi(H?z!?5MeDbyoQI z^;Ag?q(+y5mlqe$&V*&9Lba*yTuEbj*0r$&P6N&O2T1eC84*?JdYmL&-0wYybqQ3D za^2lJem3I`l7Bqs0&|8o)x(-#5DNxZnzwU;q;RBD+*}G4FrXcs=>$xqrsANigXg3o zoi=MmWtr7v)oW0=r21(y7XnL#bL}fWWnu7uSx(krDx2b~PfX*7$k`HTQK}6*I;`F* zaeJwj>LEg(D-_GkBhSWT>AsVYg2olUxJ~;BYCw`VKX2^_c3MQOSS|zZ?wcZ^n*!jU zrz}zh*}$U8KDBKyG+1-${yl7bsqNxYA_`gyfb(Bdg(KQ@=`&9OLpSur+CSuL4*;vu z7Z%$sOBsY-P>lIEUG_O;V+R)wv&W3Gh6O&A4tDu!V(+^SDl6kO@qfAJM6?!zKD}OA zfHI1a&K|#SoELVYB(%Tfg~O1seD+7Cw3uXfgGar4Z`EG}=>NvYyHE6*-EyNL=EqXE zn$zg+>e4RQIXT{V)2`$BXmg4rhw~+hZIwpQa)G0(CQ^j=H&FZee7avZ zxmCGmKA|N7$Xv^4`ASE)2NYRqrjU9_imFvPd}^5;mJYd1Bb~EW!NIeUYRMboGX8*0 z99ubHLjw$=%~0%a8z*A@Wy{R&gqprKSH?hvz~to+z}i&ksI~$0W}878$JYu_R?2a) z-2HXDy`38Nt2m;AYSKa0s(ZS;^gU3g_u_YqB0$1pMya{OaU_T2v=KwM=T>;8x8#^K z6$&HUuB~pev1yqX=wdncTKSyIy4;TIxwV&a5;RDP4_SO;nwb%1(D&(N1;*0#e(9t~ zF4kCXwny;1S5pJOd~v=7>~z+vxr%el8I^^alcHIW+J0OvcfaL~Xw$}*+dWTs!^Sm0Z^e+g1X>#_!KULd{1y;-p0D+Z-<>0izDTY#R^&a>lP?;n{g3KpR4Fqy(D9^2KRo}9Y>`xHc z^J~1Ep*X*2+1pJ^OF2dMY}d8w8#&762!S^~I}7R^X>`OJGPS@o79Uh_9ntD&K=S|< zf`PU`TY>(zgafDmeE|0f_>Js{lU&lw6F<)SiOHijQm5C4PNF)I7_ARiXSHZ#c5cC2 zZ?ZMv2PJFAzWn553svIscs=$cE5@{E+n5$1W&eDRN|Oe^xUU}-#60ukRV(kb(k`!c z-)hK{^BBK~5XBl)oW=vLV-iI~s>s%dDVDR2>ny!p=El*kWz4^{Mw9Chgcrt4Kd$4d zeQ2g?hS{bpaJb3|S|pzryZMDLG~Egx@&_#!%ym2Yf>}od-*#u8+f|fpKZ>us=O6(C z)imhD!8eQmn>+sT)cD84SFrMd&cS&o+RAVEb%OKg7uhQf!gpZNdGKq$0VQp*$7>Cp z6V}J8!C=JoBX-L&hhlj#yaiCiPRb^X$4=X#Y0H1(sk5<9@xaO{0sr@k0dObOCT0eo zEMQV#zkj-cN1p{B%$fdwd&wLdw-;nVOGctiF%}ollJ`GLQ5gcY)@1%EHpp7$4$PHh*ym2m*}416WRAaZ=7XTEV;27qZFESSdq?T>=w^KT>)WRh~~kf%=U zwM=gZoLbAX!mrh8M6{DmhEZ7XTur5;H#_u_yDW`>Bv#6}WhTnjo-Bhk!=r3QQm3#A z{o%s8b>PDa3;N-w6O*53f<8~pGM-majKT^{QK;%jH;4iHe=zcB7_HlPPkFWgwhmWB zUL59lukc^1ES&rXNOS*28>P>nXWf5RA)nY^k@=$+z(1<}zH;K!rG4eZ zo&DXnmN@$rCFSf}OI!l_A7m}}E#zM@%)a~nM~#3W@_*ia|KsiVUG~1q{`XAKzC!-r zid^?y_P)#hdu;jtG?lWikoyX`uaH>tzMlg6yCVE0xx1f}{EImLEqAdW)cj*q@t+E6 zbo5=^QcHDB=K9``&@YSgOr6QA*_u^11`}I_C*~dFYRpt!b@lYz`|IoLhsJ6uwYfvd zLdILir=rKFn%C#QEtk?6xqXjro^kE5+LqdVr^achjm&?oKO_2z(I*Y#fQ!^3!vpg* zV3@JkB^(P&pK8itjB&gNMv7JsY=Ro<`|VPSGjq`BS`3BanWZOXYaANzeA_gSlzdZT zgXIq~bB<=YOvW=vjgD2X9gXsDHF~Byxq*qJaF0^ z_B5z+qI^<7R~iieyi{5<==@QFYX!`cdZYj-uu?(P2{n5Bvc01k+xQC98x4-aS zYf<(Mn#7gf^(8iE`l>wee9_qF8})X>wKh0`iSxn?<2Fs63t&T6b;IJZeO(&gS-E^lEfeloVC7@yX{Q+q-`B zwi``g2B=mOp@3Ht6HGn$oUdVlAIsq*L6_$P`y)zh2G(4kE*)AJH?EiFZ?EM+@*gqV z_CbeubPR*{RJ2<9VLH;Rp7Q(@7kHgg?CVTM6^}jy)!8OgD&J{gP@N0>*@IwEbkeF8 zqX@d@VxJSxoo)Jw96xbDBq7mFgLp@amCGSmo@4j?6Awqwzc=pn7C5a6dm0a53B_AU zMXVON6b=mb9)bx_S$TTzT#??^q^BHLVF)twn?iu8?%j5Z8uejKr+01o4=hpp)rOgc zhBZ46jPDMdFwmBq_@36qC`3-bRkAQn=6h;f?ta6AthA{c?mPS?t!cR2Q6UMJ`GSVO z<5_Z_FVd+s;Q=8lPEWSHRGI9M@R@dg1n5Z;a?W>;mWV_)_|yplCL*%Lki3s>DrXiX z$+Nu`63IgH#@sqhxK?Wx#xqnthC~YGOzOLzNNZ+t?J&Tl-^`@|G7qLWb{b1e?r!LO zY$;CjWT{F2UZ|H7=?@6!du=iOSJasTL5Dwu z&;b1`{ltzFysXU4-0X7vMn#}3ndC}N%(iLqrZJVe#fEfof0nyiuO{@|=Ir){(kuR_;BGTf(A}B`FGb@bOT+|%_lnJTsqA(;cEuvGlbq;?1!DD% zE3)$+3c+0T@x>$Q{co0M*A;v?5)VZKyL;$F_YPPkZPnOS(zaV3jU&vLp#^qL z_vBPYgr=J4ME=H8%>7~-!*ZK}lGXPQw&ru|l-S}|F#Ox@M)Ri)x-e+h zTJc={QnZoA#*Jc+kLBZIVLQgbYmt@%?b3TYBrgYa?YTGLL&+^zC4Z!{_~Z+ne$ zXakL@%(~N6OKm7wChg74s;VI^x_M6O=JZ!EB#xhF#~m}KW1;oQp)-47oaq_=_bb2_ zAhEXKXlc6*Zd(9GeXAiiPk>4Uf9r3B6UHefriwY}vn)A_E)H!)eR;-vo9xzZNMeLV z`T2ws4l32D0fvkPZ|0Wx!!*If^>^!C>q~Qt5oe--6)?aq%DW?jvN#r{2`$(LHcv)= zml`+r&p37(G@xaQHPLPUD47?S;)k#sEOQtlTn}?rrZ%`W-fN8LJ4AKHSi6=@A~dIY zOUirb&dYJ2%W+s;j+lRgb2#Oft0pKev0e)cB3iRaX}+;}yHFn`Z+Qcc?Tzu>@7aUP zKN?Pm=UfzWtG|d)b*|WoM)60xGa(S*mLoT6**@ys?(77wr|{R;^BXDxa7DZ+LXS~& z-V?nMn8_R8A{nqt{G8doiAHG$FOh^G3IUG*f z^$ubPUO+iIr|Mhe(}0p7FsA+Bw@d|4kdiuh*b2~{g$Zq9K0?*B>{Q;EIpe)_x|&7b zZH01|K`Uy(=bS>#h(s^|GvnjW(9kG zA5UnAEjrh*a;+z-)NZOhJ~3FQcevou@?>cv6aNVH!otnUTrp22PfVjn>dCQ`#_~*A z{TaTSSSHg=_m!qh6q-r|eO6$J6Ips5rw91o|L~oj4?o!inDeTCvy5){fi)-Dr z*Yw++lRx9%sMm+sMs066hbe_B)8BUFk@WvMu3l(|#x=8>j|7;J z3ks>IFt54l<~Ke^>2)S5AcX$>Mjy2y-iVh#G9d=>{4+SfN^rT>1k*R-b4BvP|7fLpz!QznorT) zy>PEwTc_pYLbsTWK|NOTCpE!~%o+3(LOQa5KYP})LGVI2xJcqpXprjothTC)?-Re4 z!NJQ<>MkP;mJ7#2#nHMBGd72L!_N8pH-YKUcSMJqHP6;Ccro>8odLRXqQd;y(|cZx zIwM&lh<`U?enZO}&C=d>amqB7$1CrB-uU`zy)s^g5w}Yfh3?x?jo?`4$PMUQ1f}qz%QVO-Sh8oBVma2I*ZSjqY zmJ)GZR*}KEr_kfhE&|nGa7TAZ4g?Yep??V^%HwcAq`EJFMD^u)i3dZX`)sCv0TXKj4W z2*SwZQ3dsBq^NP7feABQiG?DH8=ZXgi1yWrd#zCx!%LyARi;A~&c;E~V+%pe!?nB# zxr?Ff)*{}Yn+91N_Iv|%ay#V%LmA@&LQY>Fs{FbG1^&7Joxq<3xc<|owtLJ=)K8Zw zi@8LP)=Lf%NtrCbt`N_EVO1Ma(WI%p?|GW@u(!bLl;qCKX)8xm|Byfn+v5EFEA)_TI486)cK9 zgW!AOgTU_kE;Wy~9u|L|5;X7;VIkqpC-ixn{ga!?pa%k3JQCRNZ&jdA244C-xn>my zh!KCG-=?+lNF1M5MhKYqZ|veDT{m+^N2szl3W_?Uwi5z3f|A(}iwN*+Ol-+(STCy6 z8Q6b7yGx8a94}Z|bNA6OSbE}aT|C|+*|km&LRXj7W9w^PJ2aLGQd&TbEwO6+qwOKC zb}ukp&{R4m(pq>MgV=(P-zW6X(=D2OpON7H0HZ{*stkgKiC3B@g3TUF2YZlx&YR_h z0~drD*XNDvdUJ9;FJ-Q}7`;HHe&6jjx6q0`$Q9L+V|GSIiTE*+!b48ooJa0tu6r>_ z-@9a+1Cksg*d#}p$D}(htt%&@edzkGR*fX*8}Kbh#>q0t-sPR!joCv8585~6K_k5@ zR~?@=FWvR)PB}1ULm}?PXH*>qM%H(4JP5Yv8($q~zu;!kh}H;ej-UWbG`Cr^xgb=# zSu8=yji)c4*G!rovomB;wJX)P_>TS4Msu0V&}ezto==nZ!JQow>;CPUFynHS$}j*8 zF291}EzYO5)lpe&ZEh5ne>Bq|0u$g$i9g*B7UjEt_uBUUfFF~fV047>nzvj(-o z&BtdZUqi?ZJ-OR4o-?r`fzGtu#r^YwB5yn0kFKy0%cj(}nUAvW~ zL#t9_yQ>a+3GNcko*z$H3{HMx3EQz=arEEXj2X8|sXiaXSp!~v_kfSVnZ4U_9%_Ty zdkY^Ug-1M>(=}>&QWwUxbGy-Zz|tYbE}hRw`n;f=#j1AlQAz8r@ZI{R&of8A4@Mb+ zK5}fmrX-*ulSJqPbs@-HBCTjGq7DGJ|!JKoJ3{cAlGG;B6}?&t`1ewQr^SDNXc_TT!}n^ zbBxsL!e!@rjU|OpO!Z_dbVSF(g4gZBN~}TU_?vUPFw1C#?3#qJ+%85+Wf2K)#+4we zT6*6zWT96>{yjq3cHg})es`bC~`qK>m2LmYq z;F|^X80bJAkZ6fik_!Bj>UKOWHB@;>>6yz@_QFr<8n#&HsSX1*C^3SL5&&2hItj`G z`li?V^qcxT<`L&irK1awR*=4YVd--Z(?)aLAS+lm?}HBVFs;^{@gbJxyY1=KsQyvg zWJmQ3FXsah`?ibH*=GLDO^91n9+7h|GqxqXbG<+SZG(+yrDF%*AK&t=i5&Rasx$$W z(|W{8y*GdZUOE^P^$IB9b(zvqH6U+WWfjZoP&utCm}AQ!+yE*hAr)*dVFhKAGHU8a zr`K)+baC4@SV{FPNJnMFT=mnZ6Ie+O7Nriz;MkF;7Koz-sk4D+t(Bq)4;F*0@~YRq zI0T)#aK>udhJQ`}4ry2@NsZu2%2~FtnvUD+YId=y z0*G?Iu}_tzIs&J4P-Ad0$g)>k8B}_S1s&Ms$i+mk6P8&P2Ww6_Vp?}U)Tm2iR#?KM zwx*}#=au+Nsg8884*Oj0TdZfF-DnkYbsXF2PnHTz^k4#T`i&7b%Ot);U;ClHqtOyc;{b#A#&_-8vI+$s=u&mYULE!qzIEZ?cFfV6 z!YrVy+nexwwBR}H1K8fJJbnqx-(@`5!Ws{%9ODNrQ5k`SpGWY+X$pwbsn|X-Tf7wG zDE=MlxicjsFILJYI#kXr@SOt8q9(q^GxG|30-nn0rosmL_&R$SyZOd0tVsKK)q066 z!CHarn|oQfoVeb3K)#1sUmhW8)I62o#!P8Uy7b}D0%ktyvDbW`cP!NV;!jcBU$&%S zC4fk72~xGqR|xb=tVP9xP9``pmw|+zFq7MYg)8Cw9oMzbD!8&?a8*zxFyPYYc_L8y ziS*f^Q^O3@{^+TVY!cq8MM}XT%KWe)FbW3O7}riASh3BU@XZx{6M#zRWJl$@Y_*jd z5j577ldr83^s3iqL&3YW8^vwANetL?N=iKNkyfurL<2op>|0#Y(S}A%I7zL{C&e4i&-T|1)V{8?n|9~u+TtR zKao&JxDv?T-=&xbOAEbm`1S53a8Py5xWb{>U9xqBDQiCLvxSo{l6ZmcPXRKyWT0l` z)7mLPFqE8%{c1cNP_mJ$B=11tnV){lZ7}c2SRjM&R-ziBD;G0W3=1^8O7zA9oWm0 zzTqcTkNdE{`yiK1xcm43{{=rfhY{ohJ-(*?+m=H^S1kj|Y`C3bbUV`G*V+XvTo&R- zFhk1{9o|B*U%b4R<3>a~rs7mAqIq5aOU%%DTP7*_eeE|~hyW{NSkPk`St9wse>9GN zaG@P*I<4fJ3Ah&#%#Exs1>(~0UAtF4D+x_@p+OsP@D5KIHo?<=vfM5Fu8p? zUGh7{5yH5+8dSil98uiNyQC#ADxIF#1c~Ux?Cp}u=mmFL=iK<2*7f77sFwH{=s2#c zb>-0cUX;**6S3&Zg__bq_qq2YuP25dEl^m-Xn(;#_>3>2ZgzIIn3I#!?)8khFvZCi zj~%5`+E&;{XzkM(p79?OLEIVaZQYKIn`!mfYu;FCUpeX8D#lOmB{T)Kzc`9E&&>v%t9wpSzNrDq3rpwl-GerlcHbK1U5AsJFNMQ zE{bDRg;#UHpq0`-H=5NZ;oeb^?$(z=9fgFnZs}~wYmTdhLhTZCG&-Z@F6q1%QNiHA zbnJoPp;~){5SO3>dCLdEyNR=Y;fr;fcv(~l!>Z@;tE2V4SGc;*@g9Oj5@9?iRE!V% z-(wD&Rw28a%H_y&aLS#BN0>~eE|#(Gg6^0BL9keNgc8O;lCJs<6%kgPjjCVWc@A1& zkCUq_XZ)m~JNX4VPCz~8;rN5=+NyZ>_zn^r1p71x5|VKuVaQp@go2%)(Cl3N2g=AK zoqcS<{_jblzx@)F&aRm$e+K5X!`->Wv%igz*xTLf1VsQCPnSD=< zD^l18Jh)u?KH$M6oqfQA%cbuF9$eDd2Ryi3`aa;nC7pf1vk!QnY|Wo>&AzAJ_tbw; zi2XzvF852$yzgTEW74=(BK10I|%{r_K^2y>z~&QPNh7#9q*r1aYJC80B_Ei8Qa?#ohPi(+|A zmO&zCVnP;y4VE8)@oS_`&|D*%|6lW#{!bsueSZ5%S%2o zlGY}>hiI;CmyfryaNn`G$F2?-E%!2V92vn=Gjgw=xMHGVQGqHt_D4B3566xALAH@nGM5q%E4x0gov5?#6D&_|=n)=tJw6BDw zE7y`+>WGye1q2zs%DNXUinjXt`rDSL3T~fTowzApQ(Wv^<>?K7#%Od?sav~~WxA^&eO|2lsr0ebM+Yq21@&jHq=N_JIL@nhc2p(I zj9#+w6?Dh9X^GhxCe_v#^WQn5RD_2VBGdtwNb{sor~)AFwB2?O&j6gB^noY;TP$nT z?52Lv(c$&Ak;VcJ_FL&cZAs|U)*PF|nD#1Xw$|o;hMutFG4?UubVIwKW;)*7oB#e( zjdTy08TR9=@w8&$3l_KM@|f^xm9SC1=RYXoW?opoZSFriYOpYB&rbkoLxgXpDO`xT zW>wT*Z6`rv_EQ)f3?FNBo0d0OAzOw`*Zb&!LwPAbnG%V{<8638EE^ zz9eA%vKVR`lYHDg=NYB#0OuFJ`+CE^-=9u&w@uXKspe+vstiwjAJRk^;aVQk?;pEb zPNVvCP97wPE~;x29@+8IHhMJS)nwv@OnydfWISy8Ju%(Nqgu*yW04!M(e?~#hB3}G zrBO1C7Hg-42P^jc>+RQVtvQWv&GyDJ4z!#^FN<_H42g4&=+~7G4}8@213WG=$B`U& zJD7a@Ov`ca+~I+5+EJX?kHPCY@};Eou|RccNZxU6@HNoGx{nMYB^~zC)mrGx=eoZP z-q+*=jM9AL{X-AoFN>MF4aXxg)e@z=QV5xC^HjFqM83vV=?*hGN-VhYK%C1D z704# zK?7>op(D8!vsnmg|0yS~8l&O(??v%QR^ElG<@T1m_Zx#NA%HfgZREAuE6s1XjPt4^ z;Hq0CEPb+%>+bR1AUNV*NjzalBW3vD&CnJXB5maEe5iEVh&r0R441F$6aaLx1e<^f zAh9Ik`D22wZq&0Kx|BE*%8fA^dS8Cwuc^tuyjmw4I9CegR}5(v2dpJ8u74?`Dz%=@ zg?h5Ae{gUo42?<~Ssw<{J5uS4_{+I}yX+R=z;;H*=br#pmm0>R7+M9d@~9`NI7v@W zPv&A(WF-Cb6N|<5$KUH$F!w?uIdjX#Cb}=@;iAi}D1qJ;>XoM4gv17G1gsW|W5?cs$Jy+QbyozU-1L^9kMCLI&6xQs_W z`NPq^I!7SVoW$x0QdY~(G`AG}{^nKTiaVdhrQaSt-5w|E=p4ITfv(a8O)JBDb&Uy@ zkG?9}`?{&nv*40G$CK3xOmDQE?MKgpQ(`0i$6IN@Kj&;pJh5x+I>sQr*4R8o)kI?o z8Jo~HV7N)p?o?B7DvEd1fOll@c{xN>EXw%_CR(_eL~XA*hRHN|_dEwpq-9>#F@j|m zAS3%;@j+5Dd9}HX4XRt|7Ls!My^QGk`nrn)t%3;?@NQC_$7iY^I}UAg7uJaa-l^z^ z!C{Ys78UFIcVXMW;;+NZujPT?jqJjjP@2FNu*I2H)96gb*6i(WCpu1dCfk{tY(!F> z%5n!L$|R9s!jLLqfI)A#AemNSde|j%&Tygg#^EznJ^NNpdTGC*`v)qHIryyZGz=YN5L!933vX?CTMq# zly|5D|9mXm@pYXVJo(!tU)V8`?n6T&t;3pivBMD`=?-&^8j!gyb5%zZ3@0Z?5145H zRm>&usG@Js(g^!n+BaTcX*`ZghwmPB^Y`P@^#aG_OT!d78xk}#+w`+mMWpQ_9-(>9 z2Kn$V@GSW~`dC&PBJ(Y~mPer0#AB_{j)@~rI^PQ=06TcBDlKj<5ozT5$jjTxYL0sV zAw>mx+HBVBr1bXot~>W(j-+{OXH34VGa>xEKDqv?spjE>4{WWm2|YV!`EJ1wk&c*> znWpGO>ET-sf;VWMblX&4$ft$@@YB1xx*Fzk!NX_M2otE*#tQpD{A!`4)`-?)uIEXu zPWwups-cIH$qj-Dl|2*P#Y(YYZx2y~@obL)<;mwVq6i-?+U$(Oq>7BOryL-+<&WLZ7CxTkP6URwlqu{o);(|_7j;c6<0~1DI(I3GFmBAJ6!hVWhWXe)m8oNn?2}=5DdwirD zHOFwe;#@8cmEAfI40*;-J}m(uj|Z%{xS01A`Gwljhm;Tc5sBK>vs#E(uu8BRs^}Z( z)_XgdA(Z`3{z)0oh;;}GIlvKo*>wQp0yLVCIaoW#KznihmNLS?u`Ra%V4CTc2sW$l zfe*;!ab2yI7F?~QY!h6~{yxm3vh>w~`s~VL-8=*WVV5)Lp`B@?HH))FkNa8hZoxMB z#Namb^x?|aO-dp{2I&zayHv|$OIdvz!dasUA`kA(fgZrAJ}Z|Z0ESa4vj zO{90@0VKnKDZOIO$@L5X4fUgOA`WArln*u*?uSK2MlMLXuT0aYTNPDFJ^b;>s&Pb%YJ>XqM|}Ex*$?_kU%cX*i0-RIOlYeP z-u}4vsMILeu68cBvi%mGPss{CM>Z<|B>0pPoQoUdVS7eLSv^<3eTE%k?d018eYd$w z2Y(L#v?WET`Plrdc*c-mEH$j@-P_pwxmw$)X7|(Ng& zBK94U>z>umsD|~}r3|F{(v`03eAoWG${T6Yz}7l-2(X4SN$`Nqaq#c$!1fF}5MiQ8sc&}Girk2MDRi1_U8a9$VrJ~T1@oxwQA*fVW#z3&qG z$b~y|rSEVC9(j+AMY~3-3oiXye>+psdu|+6sh&INu2e;`yxiQ~#lF72;LmvxZW@_3 zuMRX|CdO-i&T*i{J=W%{$)q+$gzI5qM8DvX}PC;_E>MGbJGwJnpfVlYk>!!2ap^O_?OqR|B)j|7;zBL?LI954xK9 zRr}n=HRB5V#tIzFoqV5dR&V?|@t>c-q#p>OVOTmF7lOj#_f%?f%aao&?pOu?Co2x! zj?WsH1=EGZUL4*F>jq#NK#!k4)R&~jq3qZ{oh*4Q(~!U3F^fz6uo7Yi5>hCC&lvR2 zul!3Tj_U)V_itOQ;+4=VAfeR3+hp=MbP4+>KW-rOc}x+`=JQwyT?Z1@pcz8bR+16*|(OlK!*P16JN+Bl6`BzPf}dqrX#_>SzfIY@Q7 zV#xaeUL&1;6TDES^=&r1mZgH*jdp|?;3q@$>aH0hmybPx~_A|*sDuu%l0_a;TU6bU^jNJ(hYAwWb3y-4VRB>#!- zXFvO#^MB9z^uC|Y2Y+JlzB9AdwXRiW&CFu1sp@^FI6e|B+e}?tuyAmYbyh zN1C3m0=k@VQ~LNHoymW}`CoAU8xQ?|2b@idZbr~QO(;n0nEdQ)vb&`Ov>RNdgp#C8 z3I>TB&t{}Fzd9#KhBvNat6b}x$PGp`?B}YlAo8?Viv5YZdkssIO!G;~WGN+w!2*N* z?qNAZU1x2k0>Nkk+d6dwA?39 zp)`KGekbnV2<^YW`ga8WZz6;L{^~zDi~mCF{|U6Ltb@)mIJ|xSm$;Sd=(J=Pvajkj z*YTc0?ad~`dX^XsOU!-MCes6F6CEtEt7C=izjA}#+lQtjM5>Zxe}+dvZVW7lUjbOq zS6U56maZ<#pCL|$1dS>ueA9A&xuR#^%X(+9=EMF%x4!vpdZ9~?#y#3rYQQCn4qVu1 zqatG+o@>kH**N!(Ds8)FhMw!wVQ=beBb77YG=jsWP{iACavpJQ#FU1 zT_jAVdT*SHYeaYv8n*}-2qjfrq-G}g#`fEgCf(zm@Ecn(7dL7a3PT3j{_eM#Xzf5XtsU(-ZQs=gBh4Dl3C!zbH-cho8os-D-q@!6KDriYmHmJzGdCcdV9a7WyL~(PwpkxE>V>a3QBr)W~rt@jZ8rN1UU_gz}$? zwMTi%jm*%6De<^3A5#~yIw))Tb_&S_#-{#x`I0&>_~7wSc;zkX2eb+=Lri2|&dvOJ zba{|WkogayDddhw!phq%Mu#6yoZV}8XlpOsw||tk7U+07nicIdDG2jtYCjEt`cOD3b#yy<5G8c@|jPoF989W4s!`y%L4NF;}KYtd%CWgY^FMK zo*N8;Pf-qew`up??KhbM(`Q7V?8;`#mlD1oA|Omzt$}C-IOk zRC-e3d!)*#8ZHt=eXzWU$@pdv!6i8&H$u^4z{Va|H|M@L3oanu?9{=0;0#iuXL+u1 z&#>lyBq!|wlo-k+*W?L+CzRJ{6QKi?8J6(M`6ZZ*U{WSF_J>Q_Ul~QvOIpL(xYxtH z{YlQP=0Ajc9_;Lf3WRML9-sNV2A%u9q806R?{8Vx7JaY9dY@iJfTf3bbU(DNb=tI#h|`C%2g*$jg-`C@rb)JvaoYCMg+3Y z&@fK{W{B&clhq-``k9tNE76mI<+%`y;W{}Bz~H>*`=@dAEQrdY8~P4sfYzh$8_Y&g zC&Q0?E*u0@bLLV{(`As81>Ny^MKy0xEKOqXkLF{`W_eb+Dygq3tLSH*_dwOSC+~k&3>a;U0cjJEyLg_47hg z6!)0baB(9}Ca6FXFn3oZjB7nj&b9sCw!g}@zrEyyY!Lpu=n<3E^N$X`90Mb})6?h* z?Ag(#@O?iQEr4=nL1zxYh_QfEn~4BWNKRB5c^V`sB-iB=)O5zGl}`Loy#Vc-9{cn< z(PgcZ5|i3ve#AXd6l`%jR>Sf7dt~_DAhDEs+pznJri&k9=B?^#BQ9`17TUmR&=pNa z?3f>G{E+09+LTR8koHBzSghtgYCjO`V?@r8Ai0o0KgHtJtq;wo%=~+A9EFQfI9A8% z6!sBHFaa4+m;iqSwCs1sH&4axx+LAa9SjD~azZtjC&H~b{)-4g+pF&A!mpQqBpbtQk87O+e&&D_skVBoc% z^#Oh~47^14I}&<7ENf=`N?)zYX;|e&o~ZILpXI?GxyNae5oVA+RtF<)#3oC*`kA_q zU0UmrnM$u7B)4YJ*#H_!u3QoQV zW_5X#2UejD(Nu8XchgRjXoRns%r%qpnBuo{V|Q3>YxPvleIb?~PkHh^ls6B`VVd9K zK)o=%P|)dcaV`!~o+O6HHBd*GO&cyVn*i6_CQcIik1EM5zq`^GFTEY7GdXwaq)UO* z5WP?y;91W_x$OsFWar;G;G}>(RhAhHIO$RiEXrUtn@YgKMF%s!%NfA}4n*(w0!XsGq_qcTuC z-5XIm15o=wUl>^URbsUa3b-U&4}-6gkYGt-+&yXF{?)7bt~9VhLq2$|yzGN)J8&f! z6cZkA1e>&pP#7}kFJek~q09qW7FToF-(JCSP8pjC>>td5JB=$=vZJ;9Jipg#*j8UA z5p!quK9Tp=5C%iIROo@cc=W~XqGgBJrWW8lci`(gm>fABcOTF$eHpv+UxR-P zX7hDrdGsdu`@Gb>wnE#RDs61{w|a zatDlC%x~NE9WXIAvmC6q_}}Ve8KufcB6zp#+m}aHLfLyPA<-A2<^t8Q_$%&xJME2} z-KB8t72#%o8g=eS#p-;&BJ&u9vLvZaKOzxUu;-P+&WtF;7BR8pDHCztgM>axcuDS- znbOn?CNyqV)qrp@Z3}DA=VQ`Uc1k_vt=h?+F}ruPG&bk&LM4u{R^)$=yK@OXyldn1 zp4~1KKsoN%n6>F;tAnqv?C*!31|Qr}u23%oATgbgPc2HJKbiVaD)v`{&tdu^^wF%N z`ksM!;0?wXMwc8?JX)orda{F$#|+|`+e6Y{7k<1u)??ToY>qSUN{8NLVKUMw(!O;G z;es;O`*C&EyVQRom#0CB-%kE=nf6NSp)(b0tBEX|wHk*06TgkxT^20>X7=85+sp^3 z*v_5i91Dmb+7fP@8>S*z3K?Fzbq+**7#o|TV2rXOj>4to5O=dlo$T*%P7h6fH^kA6u@2_55Dyl3lVvYR9M{ zXnjoGN8Rm4aIDvUxy#c(HC`?e_jF3EMud5Orwu%3Fk7N8&U``}MZ7KTY#8uUz;qAph{*{+HcGY9$&MeFvlZYZ;ufqVcc&y?Rnzv&=lv)j%;e^>8P7~TxX5ulXs#+0 z+K$`UN|tt?c+-(3}lM(jE&%mge zS_~c+0!)|=UKEhX28xKZDo0uZ!r0Ors5ze0+grn7Bn2hks&c|C+$5msEn_CqL( zwM!-YhVFh_qymG&$;irg0t-+zibXnV0>Y0#`6FG&t35EI4(X&X8jqel311(0ShzG- z=(QZbxjLs1ndDd*J2urFR#l_g4%ma33X|qK;|Y`UWC- zfruBo5BcRu>t>0OKfLzp_7A`%j33rgZ&p1VB_z$@^c4*Gn`^6SQ6Yy0U|j zwpjjAhxoR_nKfdwXMC_t(srzt)!9Qfkvap*|D0x^9qRzqV9oB5&Qn9CyY1U0fQud% ze;KoYGF=#(P;~xf9p||t88<1sbO%p#RYXi1e0x8axf7q=)t|RN-X}tEH9Q7n4D?)Cy+U#VE4iC+_pv?t` z90*FXRMp|;=Q)977b7o*J_Z8p068ZWxKCUvrQnzAY@VsCXeos5)isK>1?Xt&u32-PLCb9za*Hgu-@ta+02**azT@CMKZ<^`z zcR9)ZF?-Kz0_8o|7y2o0QzMcgmq@#_2Y&FKBKK5nwi!wMfeu08Dyl?@+nY$dwBN1* z23Vug&9;Hu(c8oBe>#meizT5VN!s%h(v%b3-KghG{{8j5q9Q;uAR}~;p>nFqgcz0& z0IbzeCod2nkM#JV%l~L7?jD$5es-P5MNsbls^$Ev`yx)WDLdHi9qb$Zv6<#xq^B4X z_N-g7MznrSG$bjxQ1*7TAaz}eo>{!t~R;5Op4nDioN1y3Ywa$YDFoW#|S<0#H z!fX@n56eKHm`PdzQEDzKc0<5khU)V5aAooO;G5NI*dP9B+MBvmk;gth8eUO**jxY4 z#uzJBI?uODY7oY{;beVpW{R6 z-VM#;J(VAq0%4aA%zE{p!J9^v!*@n_2kVY<5j=;DgcPk>s1;fiCw6|g3MHRB2y`2z z7|ETfzuapXbZ#%FdvMRQFutX$n%eloDJ~Ufl}3{Vq}&>u1PR8#H4G4 z!uAvW?sbn)@omRimq}#B3RB{@A8)C5t-td{y?<>sium?r*TzbK^=fYwm~Ez6xJrgA z$?t`iICx2MaUEES8j90_{N&-@n};~(%|`eNu6<}~Sc9)M69m)U4SjZvd9KN4M^#~* zQ5`2b4zglA#zf@QF7@gLZO*;c{aClDzZSeXrBKnBjS5_nX+&apKZrA#rzJE~e0d}; z4(Pwp7^{`S;%Y$9sx$^}7>-CHXo^p;*hT?M^jRWSuD9uLmEvU+hqjhGmTg6q{%Fyu0uY~c0e=#@XKuC~O!Ec?=AAS=R;l`JXs}@B z%EV5A)8JOXZoZ;@mh|h66Ac$8k(S?HFlq6j>QQ<*S@HH0w!z2Im8H3mi^&})C~qk! z+?cz#ibwl)!vX-fk{=T> zELUtIyu6;3YMhWu%&fkc)<#m0fW?}Ydlas#S|hK~SJs2)u1ThBHqr>M4a1i#CmauS z&Mj=${(Xr{UF6$gQdG3uw**?x%O$IaNjv-Jz*v;nv9)}WYVxXilZ67_sEl$qZ!{g@ zOE;w0^y4B!;`>L-qIpRNsx$5jCcJ4+zOOegOPACG`ix3x^c)+{d!qzSLKPll{a6EK zbOGUg(a0vgXRd(PZrP*zgH1%iEe?hCP3rZ(xz0qc;WtV=`Phka>?C-u7K@Clm~~wn zZXN^qm*CLq0nfF{I`}|1HFwE1zVy7sh+8V=(|3?yl;x`DEgpu)o4PD4js+<;K;N`7 zy7UF6#B6vt1oNb@-dj^faTG`rz6^B?vJ);-NQ2jw`UNAQcN8U1ZU>LLAC;c&@zfN# zQ!h=CS|sO&8_#^JV|{+YO;S)st~YOqT+D*#ymyp+U0$xYG(=WnIwG?=SHz3B!QiRu zj@h+FD)J(QZTcEvmhH31RQUF2`jTF2ixewDBdjW#4wg+-S~*M@nj_a&8bSjsrxSxcOQKachZDi%fXwxmLa~=2A*Bc7L`5<_O8R zOnXgVs(lU4{K$=LNWM*L88?j3dYIqeP7dKFaeHIqu5_{3^2gM9go$iAf$HXFj?`c| z1IdpCG96)EnG11moZcmcv008kvQH*R6B@8ccf`PKSMrX`MyG_4`)E1du!cc}wPF&o z9uc~PZtU23PIb_X=zY8?AbIshi?)?}z?>Y7P)`1?wLkH!RYf^+81?YwqFy1D3$k; z2Kmp<-%Ia~Z$?By`Ypd=Y4-@r{Ch~lMm}s=wziUzAfo1~^_(&lUe3&HlB;@@?TK=(&SHhTMu1{eUFz-&3Q}K8o3`HeyK#SD9?qoU5PRjl!Foz^Ks#dT zCMN;Yi1`=;l}5 z)H!EPeR63vxHx-Kyvgf@5uTwqo(JJA-fXw0G>fmm_EmVz?qQ`64(~0rWSNgmra|Qu z6>Q!t6|$jrzd$TwE8Fn6mY0cPCJk4ci_2H0LSaTbW(D3hkvUOrI1kw&V8vs@FHKF} ziEO$|M;Q8~8X6WHh)dao?bsgF^lyb^yQ&@B;L&Mxi+lxr^ocGxYOVPBj75Pws0njV zluSSV0Ax~G$nddT%3@)-m9uzRQQb1%^J~k^U+qgmK~3vzoCsx+Bk~S^s7!GCLMwpg z%-=HTAd){}bySw?vQ02Yi5GvwwAj%{vpy4LP(QlADT37MiFexXLB@8R*f>)`8habq z;0LO^Yh4t6L_q0hsq^B>yD_R;^* zel=noj-2rEN3_x-*NSyo(~`YH>h+GKcJ|h}V<*9ci*NIorH5|=TkP<8-5o!f83@9O zy-BGwrV*#$nJ2IGk5fql?C9WqH0e7B=VgvnjAY!3NW-NuZsLchI5oza31gcSg5@Z= z(!Ac!benRMK=KY$+xui5FoJLH2&loV%kBui^q<)Z!FU9;nfnEu+Fr0Acg;NeQF|pG z@^&K8dI8`%Vgx{hOf3JFYW&*2&cmZ;Frh@gO5=Tqbe6r8{WisxPWP z3KE^33W-)~(94R=XPSov3Gwc?C3g01K1sC@@|2FiS=9Nglx8cf>{{QN#QDUBVIo02 z=)^qcar@7?+ATsXWF8uUcuCdBZ-6i?!Q_UyDm85666LWVK^Xa?qF}+oLYh49j5!Hi z`}xFFvS04@{5=%#)cJ0sJGL%}Fa0n^wx22NZ$WSAPRY(^U_1|PXqqHn^-PVdz2KaftaMZbS45_%AV#opBb_WuftBPX1OEwvBL%%!o$RzcuT)#Pj;+F zylRFz+;5`RTlLPu=?2}s9hgBM=ACYm$YRa(UC2mSy}K8xyX7Ucn{v1`U+Q+BTWq!2 z_r}rfKk6rWJscmz_XI5LK)P*%jr1`e6fI~N%rE)dH@=`0T6b56NfUMmbLBnO3j3rU zyLgN3Pib3r{w^oVA8xAqd@G@XfP3jms{H+*g5j+jF4rekPlsb&w-yK2&@7MFCXd@5 z?8SvCLC2G&PObrOn|W?OUBzf0a1+HRb*uQN;Z#iO!4xU%sG<>>(F?!8BT66S)h*+o zf}U7lrr*n;6lvTaiG!*sDuSXC`X~v>+cQKLjpe!ZG(Vpl@ZW{BDUM4z$!@L_L&O5+pR=2fy)_e7&L!YQXn~WqL9rS-WdnVWZKfqiUi&Gr;=C z{PG60gA(jg+OVCX$9;XD0 z+jV+AUA$IDu@x{%)M!_NZ$kpMpE6 zjqKY#n6-)CoqvdOt%~=+aD;ADkTY9UH(qxN!j@-F23@Ah%>e9oVsy45vcZJ}1a#gH zKhnJ}Bgx(HBT8MwL%Qt(i(2aMzoc<%$F%C6PZm`gW)w$!5Q3n2ORzBSS8tn@0G**7 z;nT3EJ#1N_Zaj5r=0IS#bFy-rX1U5`sL1z@h=%;t1?1Ai&>Tr}bh|3qt#;w$T$=x? z(f&+DXj3(p%?J8a!=1qC@`E;RSu>h(G@!)%$w`&wb z2R52q(_-dn6b!>}&DI9=<*HgmF}L^4xuq)ZpuUcYofd*GUo}yZL>OUcgU9SjI2(yz zW7cl;8#d`xf)H*j708<@A�sP7zqTmz=GS(UwG5VRS=Bw;wRAopfw&pPg~Nd1q` z$pw4y&I*Xavg&IARkP9X&W(G&%MzwSR znavOPO4JG?mdHZWz03w$l(h|owtfL8_3|WyJ4_pHnSPxc2K9f^$h`L>>f*?a+&dXd zRQqwR{cfzCJxxVQQA4KL%f#N^;%!|ss;5Xe6Lf-Or#oa3<0*?=RLB{x-Scorhi}*U z_Y15U+2TUDRv61EZ~^QEBQKpLvknRpl;r}w0@+PO9-ABsGsqBx%R-$Mt~1Xl4m~39 zNL*{`boMkNZWUEUY>-2nvLTW9vNJG@4Y$?N!P4ThI0#u6#mm`X!QIloZ+x*(BOy?z)rs{#XCN ze5A7CU1&1nwtI=846`XTsZC?qP;<=$C9@yMwO)~U@Ii55P5t50sO7#C=ghEOv--}6 zO$0{b5!@`W%Pg?N<+7+$P|4;38(0I?!#^|a3Qg|3|6F`Y4UlQYq*g^B**9#EpH)d7 z*?k$YhMq_)DaJ}Unxb(KX1dAbgV#x&_rv4Y+g*Kd@Et~W_~uvtlYRkv_S#k#04=vI zZ%r?{w9j7=Gu^aJ1C4!tLOSR#-(lr#G0W!R%!O;SoC5QBqmNR&flJb zP?J#|!gp1A zRi_*V1i%It`rp}EkWbibI<&WE4j%Fo`u?7QB9`D>aiR{2^ zppTLR+V}1rLE=Au(SqKL2{=#l{Mh3hZ3mj3wd|6f?k^4fM`R$r_GTG^B)=-Nj?uZ( z{H2|@g38A8Gd1i-5EK$crl3y4zFo|%8x=Y?w>For8O?gnW#;=Ahv+TKP{G3D=(099 z6KBq7oh}!+4_$5|xmoWjI_h?EabM5)Ix*Xey=!lim~LQLY`wzG z8aeYt{EIE>w&w~%hv*0BHKn5q|;?Igs}~N4tC9`_?p4KPARBSY&(#>Q4mf;9*(Hclj-fn`4IF>@Z3eO zPO*KF%JdalKPnoeL1^&K{13qh=d$08?^9>~iRrENB3-LT=EFd7l~!8Df(EwNR5|9W?6sI{(uq^g)ryikf6NA$Y!~j);UR7y5pNH81R97Y zKIk3l5`=Zr{ec37fQFLl9Z+@C^^!6>wk(jLz2EH>EhKSDMqwXbV4wb6V#vfOS|qedi-x$Vb@W|uJcNHTh%BacFW>XlTt9dQ6eEy&H zj(la26ESsy0q^|$Sgpu6B#U7U4&u#_?cDgCy>FI05(kF9WOP`&8+5V8%W*&u>Yld($+~5FeKY@AO~EfNHC&cenb6d1gM$>^Q;7B!3Mb z7;yHJ#xXyai9ptfi)Qg6Z)uwVxVabCkdV*NF=UI3cXuv>>Ct!AoG-k9GV!83%U9YD~f0@_O^J8?}JKs*_` z1aCEE)T*va{*v&lNQ^>h_!XP5Sk}V_HXLGG+2!y^>NEm!ONwsvdDbm3ED~}!3YYqF zPQPaYH7WgUZwv6SA437+cE;-dO9TJanz>Q~g7DxX#gH+kOqI3Y?AQsQZ$<%bXguxa zlE}xn+ST8|g8I>y($wsc+R@>uGsWq-=^`L$++g38G^gJe81QxK+jB;dh(zNb-6sa& zbHf;keoyP~oCLZt9hvRJQRL8i@~+z{FJBG&gf@a~)Kf);Gs&r@A{kI*eUQF8bI^ej z<<%y(G5P|v*)MMuMIlpCAiJFU!k6~lw1_Iq5{a2HHLlpImBDh1ACGMH`};?)7V9Xd zyJeSUHUn6OuxSs%&WwPP_8ex!IEZ?bW8F%}^e@6BU@*xMxMmT~y;2=3G2B?dGshgg_(<9J z)|YnBo`Ok2bd@QkGMr=V{1SXMdOP>xMo)R**nv+e?VZ!Td8#@U+E}{Hr7C13agaV6 zx1Bl=3E9V8>*zR!(4RY!O^xt_g21SBAE9$KAE^r-2jrq2!g?EUTz-wrvUAth-UE4vh5;~z#noG!?k%nB(_I|pqLw!-;?_hbO^^x;YqEPY z(TpI_TCEHS@w|y1_dsIy2uOEa;N*dSDeV!Uv!gmuc`iT&!=@VW*I@ew@zBp~(DALZ zqB*M8G&NveiO-3dt93gebWsenhQxp`T=((ra z@S+2&clOxoXrDbY*U{?5B$pByhw-Djlbe7}K<`b(lVIYOP?aCDXY_x!05!$Xr+}U? z{4kA!p|&9N;ZudVc!p=vbC?p`J!03O>kxhAZD1qn>hIgG15kQ63%KOdov*zgC)T!x zACA_(pxU6@U8pw+FR-&au~9%>r#VV(g8OGAZ!xuB&1p8Ey&Mh+&6H zp(w;Q!da7*@?`2I^Q1l?eP!q&cr7I24g0y?Qn|5566UT<7woIoQ)Q_lt<<{&C9HuJ zU}sHD`}ePm-7B6dPRtJJAa%gtbnwf=M}h*G(c*`!?T9-{B0jn*+e*T7#O1}k++|Aj zdMg_xi`wD#fOd1?%ls&^7^uw5>`udx(|0MP=9&G67L#F;90_&T0v_LlIUASxZ7srP zSdgU`{moWSZSBNfE2KSg9%wr^s!WB-7#GwH6g+Qo{%UJ>Woow~sO0xcCoRS@99r${ zeQ~uR7B~sPhod8*EL~`9nC+%`1Z7U$0h#pK&LuHigd9X8T^YG6wviD|?OG(Wvr*3hfOM#(V@)Ix3S}vMmAak<`c>(FH zr-2GrQYK8fMY|d7;5-uJSD2XsxQse93Vr4Ee@kI!F%?|km0 z3B1{QNE2ssF+nrE$Myy2W&;U#_>(L_G#S){)?3^_57}~Z)b8LgK%KXF=<0^#2o`_??0S$Tdq_ z09rEZWZH98@Kp6Q``T{WG6maFfr*fgCdWv0UvGYa=22d_3LMwfveA4z0568^?v`8G zvtLAYsaGqAAk;A)SSIi8>75hIi9SkD)$c1hK*>E7i&)1ZUeGIH%CfZ&dbU6Xl`p+lVo+gC~#hzQBEG#=-;iB&OAR;?X#b$&j4-)K#=-x)K)s0$tl? z)#b2$&q@cpF>7~uTo*tz=j1z6o@?`me+Cm7T{Nt>8U?q&dWr0;%3c@f_mm@~cy;gH z`_;Lfp$*H79q=#)ffu#YMM!k{W%(vW3B7mCLP#_*v+Iq*Rqy^hhwMy;Y%CYxijqU1467?LQf}Gr?eFQ zt(KKJ7~!v`cT%lpai+)y4Tp>vWa<}gD(`;-(M{tu&H+RP(%A%pv8*|lfaTf#`~*i2 z=#Hr?J4ywZy2`VTN#~$22vITcN-S=D7pxtaPQ(aE1EX6y-p>a@O`F2*R+*eNH}pI1 zN$Ms8EIw?_q;Y&6Hai-y)S?hQH&Q<-Ste4Zoer0>!%i=*@(nt0CLaqE0(jDJXgd!S zBJ7sJT4IVj)O@1u`mgM*_d?JCah74PDbUmXCBfynuo==#Apo>A#_#0%YiBS37GpM5 zV-Eq09C9uiwL-%{B1+ptGtOM(7<|M5sP4C`zI%XE@fEO{4&d3ND+~xTbYO?Ui+7&L zV5Odf@0V?4$AaZ^zlZLn&A8YIXp7MXpXtpD`5sks6<|^Ig7cArg;OUbdfT<$Qthl( z_yfq~3%!m+EGWDV_y&z-Bnyh$Y)4b0j`?Q*k}nN)+pK|oT7Q{wuTySiVVKCDY7h1T z3O#g(KsY|%k6Buqj|LpYJ6$l4bGrI~fGO4B4BWYKlznp{pv@z`rB)|Ag)<;PX+PBm z>;WMUoij3DZ_q)1U<9pG^ZlR)=MEM?zUpK9@=zQ51$*R5stlC?9;;f}1^R9b22_J( zbo4NYCtW9~O<2#V#_!79n}?mexhVY#5Y?+BxG5xZE>95>%?FjTx~*x?^839iJP4uV zdnVuV@&aXc8+NDzAASg@WD^cW!#I`V)sCy;KdyazJyXN?(ckQQsYK$`SWaR7)zd5* z!1s5mmAC=%PB@o36}aMVe7ctU-s{(y6c*>(ne}_nNB4&fdMkg<1K)v|;obYuJO-M>mV6)-W_Xhyt^|11`-Ril-qO4>1Baay5bRcCSHT+O4hF`t z^X7BXt;7#MrtgkPCNBNh3t-mexn_Lq@lECQ)mswzGm$jJEzkf5xd*o2-d-O~{7H{O zZ<^kMRuT+p8@pD1(G`b2jY9fv%zCp)yVW;Fxy33M(rqpnN=KmI04zrwb3kex6MB@{ zX&bCnnRRa)s15WfXuk%+6Bb^Or=|)&m)rd445`ggzn0!A^}ZDpmeelvsxUTqJHvEy zg8fTCKR})D>P$^6=+83+%!#b^)pxrEEdJK@I`5m8Y~DyvkFx06yFHU1dmL2M4wa3a z1ae_p$&PCV@@)3)`0I$D-jhMG6Yq0P|2$U1tm>gJ{A`sWx2N?~jhcj7*>RhOEnp5y z$#>~g0XM6H{!j>LG1EXA|T` zU%mVFukxsM5cOO()f)9??T~NpErT^2pR9nzAL3er)4u|JEvf0C6tQuzC|^tLWcDs5 zFREvNG|T9Ak@j;SvXjO07ylC3ES+H|YW>e!LMx%)K+7>PQN!wbX*(_-*BxN4 zs~;0DK!iYK@{sH2F=_uJ@4w#i^M|Ih$7gPi&VgfRW|EomG^ZA1a#+vy<~e-$>hLWF zFs7qz-rZlS`P=iN9)}`Q60VmW{x$3M;}-*dd{Qz8T~W8GZL&_&!X{3%ajMGcmK-qE z)FLo^6KKwV+LHd$0slYQL-sH8`S0$=e+0#^VCcWP_|vTauOU|a2uCftfMJM@<}6}KqUY3$N&4j{{w=os_4>E z``v4oK36^5SAIZ>yoC>E%;OGBa1^M^R+6>842l+V*G|0SrXI-nZ){Um;DgyB+$qbg z@6#JK)Y_GvLQvAVdJ-RR6X^67kA-i8@@PVX6s+~%z2sPDMpG$1WeIGms^kstut|^c z(n+6|f1=T*)A0pWHTD?=Jh-z;A(uMG?JuyyokA83{ zNAqK3X~nPhRO%>t`GaCp3yRVIaZBh=|C4o? z3WAE9OY)sB|0I{7aE2l^5@WGUh-X`{gmWKr@@8l-jUg{7??RQ@uU#E~Nul^0AEzTY z2=(tOrh<2x`8wC_AyUFja5m-9K}g+~8vc!>mSShLNJRE-Y0{=nl%ZW7mfJ15dTV^? zRlQ{@-<*ME>D`BFLT%*^r%ZXGiqvD&xZ}IN>=0zpy4@>HxA@ndf_O@1(6;>yv5oeY(URvX{|T0}-uE9ZL$?+LaoRCNAyv6K>cN43 z4fECi7N7n`&Q{_yn#{dB?NexWrbhAEW;bbi^v<`&9MPbw{T*ZlkQPzdiG6OQCmt)gXP9=H06C_^3(`OE8Oq3;B-vql)Y4Hy?$ zR)>d6sB&C_H7#y;uw_y*5ySP2qE;`r&KT-B_r^NDc0!Lcy z7^#L!>xpT6OdLZ0JLA8m{zf!okKnT$CDX(*B?Muh>va+W<6&td^qwVfhB}i% zOd!nfaOsXoj**&gFgOSGEo1k!j)p61>G6C_dK`YQ(NDvsyI;$Yi+4K|g52#~O{f+2xuUXFkFlUd zTbvCxSrpmr(RQqcA1B_*@=LiftdtBdgjrT2`p`Bvdtdz6cqK2!`jOnT7CsXm^rv6DB{*d91HyCx{c?q&?S32M)x#VmXv}rnSX)Z0MJPoaH*1_1+dyOf}E77_VK=2W4};b(DDB z$s5fno#vAvbKYgHShENM8O79Gxn*up|2N5rhAGzwr~j){0$BIY8Nr;{mplvQVEobA zg5zrZ8tK3vjY(xi3-4hdOUZGbN1wlDvg=a`6%K7aV}~R7CEr5fkB&YWZZRN+{@f zG{+pG3|IAaEKaF^MizvgT>3&{2n}RDc)c{tgnxU+&hwtkoVdwUU?_=6Q+;oz5}1Nb zB!04E(>+w-f;jZ;rssj~B8+4 z+<}m?6qxI-Rk~lGA~uk_td}+@I(n{C5q~y>nfHjv;;PmCRoVL=>*bw#wDo!QiZsXI zXPCJQ_B%_{lU?m-S`LT@OJ-3%53*!Craojh@aT*^RCHfk+Ro;T2mOe0sLAqKTs$$g zFR#hW9=pVZAKBR7Y_v?>#Bv`oLB9x|gwNqh*=*-#OrrUsAI$C)HpYdr^k~I&D0*Yi zTx4J|%kNj^P~_2vf_vvp(OjW|OdI=Kjd4B@rW?eqIdQcaZ6=)d<|=l-aTCJufABwl zVp*2|zDPaUD{JS<{LM8~+JU>8JU=LwoWj#5lO%6hk};v z6k^ob&_Zqe5zNMpCiBlI$-2rlKNQ+^Ii7zI)`5j@IN`IlGGO9-Z2=}KzUd-tM~%lZFDkDZf>G2w~6Sgm}S zvv?GFeLOITv?zr`KsSJ`XQ=+MrUjnQCFNnO1Hg$ ztdY;n>fTZ$`IP_1!Csd+P1rrbkuQZU{Ny#aIemwoUjJqHN#CnQ-ij-Zde0uQfBUSNCko*H{61fR;Eu^PZ3q5Mgc`2cB$gC7||CE=N)?ib~-KCd$n$zCU%M#0Dr`5OsI2BFsO}&C&SIVpmgTop+e6@2DF2t~lHy zG7L_re`k$Vxd1}HgNl=M0VS8=BQps1k*S&B&8UMn!LIIFMC+4SA~!Db%|DG71Xk*_ zE297Ct3h&gB*=4$7{R2j;>yCeWis@J(2In!7bl`=3-TTE4Osd_@`&0O?{xZ zJ~@O}ufd4RJ6(!cqAOT0nSK?#c_Rv^bT^ldkTUpz6m)XowVDV{Y_cx%X&+--*@1(~ zWnRhb_!({Khjr?Gn5%azW3T64jvf0fE}_F3cnQwSz+WY1c>kJfgL z-Glu2tDa4~+>@!*vN}d>xVyxg>it()$yS-{Y*lN?o3*tu(1{4yLz&}F?@BrYVW$#G zE&KQ05bwU&^PGcXXv1r3x0aaR$$Nh1IN3HDwW%;CSkXRA_~Whkr(8cp{8v7^GujiL zgaKNL0@MeApoKNQAj^J;0v zwA~zsl=)}j$`#o#(+nJuBV&;1V_0-40mO;?Iy|B=Z4NPfs3$1b2T>Tlh~#;rbay+O znsx=W_+lU_++a~6952XkOG$cm&$K_4+qoQ)@c4;JIM@T}+FYd*g_(KzF_s;J3c_+N zt~PpT_CZsg_-5gBiR*fE56mok)B`+4q-MOMU;=9Ee~++}K*Ho0^%mSM^N+5^F&%8B zvH0#CN?6)x<0kWYIA%HVGjVc6@8;#6V8|{-Z`bjLr~3;>Gq0vx7b@$0@ya%_T~|au z!i#l>7Q{lu8uB#{#OT0I<<)Q<98w{*vin!{gu>BaUH8Z^_s$)6EA{2$BnpF z<90u`TvA_H!>_Y)TPExVeupw~-V2Z~ld=BW5ye)av}g^#fAxsUJGAKABxxQr?ejct zbn#Yl+?+%6tK2sy7w``@*LWKfuPf=So>{L8J<7WpWn9v6LS|EV?AoEs0f!U}p1)|E z+v=ivbU%5TuRbqKJkv@hK9~O7hBvXeo*(AS7tzGx!w*9|dGP&kXyF-m?UcyB)6)l9 zkWdR9Dp&azyXWD%FVaVbe~)Q_F?nNj)Py4PS!`u4C0fQ+3#}KlTn^QV=d^7Tzx-ev zbB%H@&^#iUZ&p)lI_>F)-WSh2kcf}<@Iw07ErNUYxa(AP3ySLw{6&l9C{n}iy5Ks3 z39obR?@Hw116e1n$GN}CzW-C00B7S+I?Fi5=AJOlSGWf1`4+XrpXpJLQ8hhL7sK!c zs#P!UfooY|TGKQ>!pwpfq0!8VXZYcb*;zazm*TVW)SFT|v!BzFdIpiQ`{2OndxZ%-xnSV9h;ImJ33Gs65F=qSmuZi4l@zvT7^d9J9YWR2Ip{j!y zGt667kVQSM2=(Prh+a<>=PbM?1ItE9-CFV|#2}j$7qiOuJBwE(S|!{BmgH>Y@9-}k zJ&BL)5W9Q!QJTr|7`+-)@@oTMVagpu zpomuIQqnC{j)ti~grl!5N~7v;-!7U2c=%n-=P216t z_>p)+aw}1r7+vpF`@9)+myfjY&Pp)u`7H$>aJ)2S)LUh_zv?VDZ*z80eGicja~;{8 z2;S6*PG0SOwEUh>8ZJPqUE6=mud#isYSk)Gr$^=z6{+sq#-aTau z2dCTo%h8@zTHg>CxX=(3Z$r%Ma&PrLZoi5Duf1!JN-Evr*JgUS%)A3rW~OE#kngu? zr74<^AVXc157aRw%ST$Fp{CixV&zIx5`0XW0a|Ee)+nOljF<{mYMFX{P!u{UWuf8& zg?s8=i>%fBeeas{*IDO$>zw`VZ}0v6_ILL8J6_4}#Kam^cLVis9wZ$N6x@d71Dd!j z$-yk=x=e0~LuuOy8$@VroEL^Wpb=dLH9lT2%w+g&xA2AV3M^wUQQ2V_ zGMXdSipYHytmyV_fRCkX_{4rSRjnd!w|r)#<|Z)1X+9)BpQO*zf-?9H&4cWhGoEe< zPqlP5#P#YiM;@!ylm2z#sOuj)<7+h+P`Q`9s^<4#1e>1%Xnov@X!e+8*-v}9{v3qF zG9a?x=`{gYwRFhgd9@uvg67Sj>!K&T1BV2Ujl zEgKL8p!#uY6wHghiUFlycsyce-#{8=!9&ok`J0h76S)cC2+%EzaC4yOE{v&;G(x6X zHga$$zcGxO5J%o`3L?QFjK%qN=3Yi>QXtwCjo+hf3Rg=!OL zesyM!wLW*oZOu4yDjHaJHNQnmQuBj$5Es@}5?g=9@gCp^oeGw9umCXk%M+D03aa}! ztVQlGsH&R#Aqyyit4*Yi6~0h3BXJ&JbeSL%W?d2o#OG=_6f4xp@Rs^L;v4R>4lIfc z^85L;!h=5iwfRqP6A)$W9eCcBb+>tJ=*x#k1?1;@_$(T&tdq|tmyVIFdLy#;B1fNe zMKha>0{b#$^=XslzM*Ekog3n!Yku%R#I-IpuP;SB7?}Fx^*b9IP7Z~wA4}(ikost6 zR0*_0J1d?jCExgkEv8S4BWBP!$A6OYL8z&%BPDw4{ABhTqugy_AK^&fzCpa|ECAi| z)66}!gNJDo2E(;Rv3wspC1#NS|qgjI;O{V6kQ+ee&AT+^~g;n?Hvutn7ZPLx!XVGus&E zqm+T=?X&mCvC^lYL|7UoI#(+&6V6UAG-1s78P7?ixcN78B58N8wdh_Du)n<6FJm+z zx2>YR^W^Vx;)S@#o^4Wlsh$LI=^&6MAI7X)rph+7!Sir70F>>|^Zis@3~mlzE1erxRVu_D{Xn@4HUwDIoJprl)}PDtmpX zFVG7w*-cPg^PPHmMx+kK^LkbiDjoq3OSVNrcTD={y|wp}m_UX6j!j@gF1yKGsU*R8 zV(iHi>#q^Yr}**V#BS@m*Uu7Uf?-oe*k+C#YK*ePltt?^UOU*DwTQ`~NA*i6Bo&^T z2T_Gp$IC10w|$>TIG)P9lTHf~rRdM9`ys<;2uI$ZMhKJ%+x6DCZ7iI5%5fpsNwfBA zSG>E#DdL5|EQzm(EJw?(5=v0vOpM?@rx7#;x(MN(C-Xh#0Sqc5g-RU>jydXj-t2qz z*WaXMo$?VJ234Up=E3E0+N2pe2S=cp%V2%GnJkaE%CGQ^f>Q%UmRie%k{O}#YLxo! z=G;Kz^>T4$3Fa-?)J==qG{Asxqa?g0ak4bBMY0__3f)dTEEt~GLA2LD)pvuBnB_Ue9aU;uSyyV`v zGGS1d>O1ntLM{tRu;{8S>{3=O;e_CT(L)jN496gcUr%3gOTU+X!Ud6yzaTvU%jSU^%6xCLExU=xo5(t06D zB$P-~NT+s%$f8%_S$_&ky#8={Ww z0J+-&1o#pq2e-9)2lUn66X@irlrhdUh-!ZTVqdrohBhwsPXoij*2$Gvl2q@_q({Pt zPKF1u6}l28aZj>%|A5((+1;rf74)2P76#kvK|GN+K9(<*X batch_correct_counts( covariates_colnames = "condition", - batch_colname = "batch" + batch_colname = "batch", + label_colname = "sample_id" ), "Batch column 'batch' contains only 1 unique value" ) @@ -62,3 +63,389 @@ test_that("batch_correction warnings & errors", { "Batch column 'batch' cannot be included in covariates." ) }) + +test_that("batch_correct_counts forwards plot settings to PCA and histogram", { + pca_args <- NULL + histogram_args <- NULL + + local_mocked_bindings( + ComBat = function(dat, ...) dat, + .package = "sva" + ) + local_mocked_bindings( + plot_pca = function(...) { + pca_args <<- list(...) + return(ggplot2::ggplot()) + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + return(ggplot2::ggplot()) + }, + print_or_save_plot = function(...) invisible(NULL), + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts), + "norm" = list("voom" = as.data.frame(nidap_norm_counts)) + ) + ) + + batch_correct_counts( + moo, + count_type = "norm", + sub_count_type = "voom", + sample_id_colname = "Sample", + feature_id_colname = "Gene", + covariates_colnames = "Group", + batch_colname = "Batch", + label_colname = "Label", + samples_to_rename = c("A1:Alpha 1"), + add_label_to_pca = FALSE, + principal_component_on_x_axis = 2, + principal_component_on_y_axis = 3, + legend_position_for_pca = "bottom", + label_offset_x_ = 4, + label_offset_y_ = 5, + label_font_size = 6, + point_size_for_pca = 7, + color_histogram_by_group = FALSE, + set_min_max_for_x_axis_for_histogram = TRUE, + minimum_for_x_axis_for_histogram = -2, + maximum_for_x_axis_for_histogram = 2, + legend_font_size_for_histogram = 11, + legend_position_for_histogram = "right", + number_of_histogram_legend_columns = 2, + colors_for_plots = c(A = "red", B = "blue", C = "green"), + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expect_equal(pca_args$samples_to_rename, c("A1:Alpha 1")) + expect_equal(pca_args$principal_components, c(2, 3)) + expect_equal(pca_args$legend_position, "bottom") + expect_equal(pca_args$point_size, 7) + expect_null(pca_args$label_colname) + expect_equal(pca_args$label_font_size, 6) + expect_equal(pca_args$label_offset_x_, 4) + expect_equal(pca_args$label_offset_y_, 5) + expect_equal(pca_args$color_values, c(A = "red", B = "blue", C = "green")) + + expect_false(histogram_args$color_by_group) + expect_true(histogram_args$set_min_max_for_x_axis) + expect_equal(histogram_args$minimum_for_x_axis, -2) + expect_equal(histogram_args$maximum_for_x_axis, 2) + expect_equal(histogram_args$x_axis_label, "Batch Corrected Counts") + expect_equal(histogram_args$legend_font_size, 11) + expect_equal(histogram_args$legend_position, "right") + expect_equal(histogram_args$number_of_legend_columns, 2) + expect_equal(histogram_args$color_values, moo@analyses[["colors"]][["Label"]]) + + pca_args <- NULL + batch_correct_counts( + moo, + count_type = "norm", + sub_count_type = "voom", + sample_id_colname = "Sample", + feature_id_colname = "Gene", + covariates_colnames = "Group", + batch_colname = "Batch", + label_colname = "Label", + add_label_to_pca = TRUE, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + expect_equal(pca_args$label_colname, "Label") +}) + +test_that("batch_correct_counts handles histogram label combinations", { + pca_args <- NULL + histogram_args <- NULL + group_colors <- c(A = "red", B = "blue", C = "green") + + local_mocked_bindings( + ComBat = function(dat, ...) dat, + .package = "sva" + ) + local_mocked_bindings( + plot_pca = function(...) { + pca_args <<- list(...) + return(ggplot2::ggplot()) + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + return(ggplot2::ggplot()) + }, + print_or_save_plot = function(...) invisible(NULL), + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts), + "norm" = list("voom" = as.data.frame(nidap_norm_counts)) + ) + ) + + combinations <- list( + list( + label_colname = NULL, + color_histogram_by_group = FALSE, + interactive_plots = FALSE + ), + list( + label_colname = NULL, + color_histogram_by_group = FALSE, + interactive_plots = TRUE + ), + list( + label_colname = NULL, + color_histogram_by_group = TRUE, + interactive_plots = FALSE + ), + list( + label_colname = NULL, + color_histogram_by_group = TRUE, + interactive_plots = TRUE + ), + list( + label_colname = "Label", + color_histogram_by_group = FALSE, + interactive_plots = FALSE + ), + list( + label_colname = "Label", + color_histogram_by_group = FALSE, + interactive_plots = TRUE + ), + list( + label_colname = "Label", + color_histogram_by_group = TRUE, + interactive_plots = FALSE + ), + list( + label_colname = "Label", + color_histogram_by_group = TRUE, + interactive_plots = TRUE + ) + ) + + for (combination in combinations) { + pca_args <- NULL + histogram_args <- NULL + batch_correct_counts( + moo, + count_type = "norm", + sub_count_type = "voom", + sample_id_colname = "Sample", + feature_id_colname = "Gene", + covariates_colnames = "Group", + batch_colname = "Batch", + label_colname = combination$label_colname, + color_histogram_by_group = combination$color_histogram_by_group, + interactive_plots = combination$interactive_plots, + colors_for_plots = group_colors, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expected_label_colname <- if (is.null(combination$label_colname)) { + "Sample" + } else { + combination$label_colname + } + expected_histogram_colors <- if ( + isTRUE(combination$color_histogram_by_group) + ) { + group_colors + } else { + moo@analyses[["colors"]][[expected_label_colname]] + } + + expect_equal(pca_args$label_colname, combination$label_colname) + expect_equal(histogram_args$label_colname, expected_label_colname) + expect_equal( + histogram_args$color_by_group, + combination$color_histogram_by_group + ) + expect_equal( + histogram_args$interactive_plots, + combination$interactive_plots + ) + expect_equal(histogram_args$color_values, expected_histogram_colors) + } +}) + +test_that("batch_correct_counts forwards the default MOSuite plot colors", { + pca_args <- NULL + histogram_args <- NULL + expected_colors <- c( + "1" = "#ff9287", + "2" = "#008cf9" + ) + + local_mocked_bindings( + ComBat = function(dat, ...) dat, + .package = "sva" + ) + local_mocked_bindings( + plot_pca = function(...) { + pca_args <<- list(...) + return(ggplot2::ggplot()) + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + return(ggplot2::ggplot()) + }, + print_or_save_plot = function(...) invisible(NULL), + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts), + "norm" = list("voom" = as.data.frame(nidap_norm_counts)) + ) + ) + + batch_correct_counts( + moo, + count_type = "norm", + sub_count_type = "voom", + sample_id_colname = "Sample", + feature_id_colname = "Gene", + covariates_colnames = "Group", + batch_colname = "Batch", + label_colname = "Label", + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expect_equal(pca_args$color_values, expected_colors) + expect_equal(histogram_args$color_values, expected_colors) +}) + +test_that("batch_correct_counts PCA matches standalone plot_pca on batch output", { + pca_capture <- capture_saved_pca_plot() + local_mocked_bindings( + print_or_save_plot = pca_capture$print_or_save_plot, + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts), + "norm" = list("voom" = as.data.frame(nidap_norm_counts)) + ) + ) |> + batch_correct_counts( + count_type = "norm", + sub_count_type = "voom", + sample_id_colname = "Sample", + feature_id_colname = "Gene", + covariates_colnames = "Group", + batch_colname = "Batch", + label_colname = NULL, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expected_pca <- plot_pca( + moo@counts$batch, + sample_metadata = moo@sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Batch", + label_colname = NULL, + samples_to_rename = c(""), + principal_components = c(1, 2), + legend_position = "top", + point_size = 5, + label_font_size = 3, + label_offset_y_ = 2, + label_offset_x_ = 2, + log_transform = FALSE, + print_plots = FALSE, + save_plots = FALSE + ) + + expect_s3_class(pca_capture$get(), "ggplot") + expect_pca_coordinates_equal(pca_capture$get(), expected_pca) +}) + +test_that("batch_correct_counts histogram matches standalone plot_histogram on batch output", { + histogram_capture <- capture_saved_histogram_plot() + local_mocked_bindings( + print_or_save_plot = histogram_capture$print_or_save_plot, + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts), + "norm" = list("voom" = as.data.frame(nidap_norm_counts)) + ) + ) |> + batch_correct_counts( + count_type = "norm", + sub_count_type = "voom", + sample_id_colname = "Sample", + feature_id_colname = "Gene", + covariates_colnames = "Group", + batch_colname = "Batch", + label_colname = NULL, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE, + interactive_plots = FALSE + ) + + expected_histogram <- plot_histogram( + moo@counts$batch, + sample_metadata = moo@sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Batch", + color_values = moo@analyses$colors[["Batch"]], + label_colname = NULL, + color_by_group = TRUE, + set_min_max_for_x_axis = FALSE, + minimum_for_x_axis = -1, + maximum_for_x_axis = 1, + x_axis_label = "Batch Corrected Counts", + legend_position = "top", + legend_font_size = NULL, + number_of_legend_columns = 6, + interactive_plots = FALSE + ) + + ggplot2::labs(caption = "batch-corrected counts") + + expect_s3_class(histogram_capture$get(), "ggplot") + expect_histogram_layers_equal(histogram_capture$get(), expected_histogram) +}) diff --git a/code/MOSuite/tests/testthat/test-clean.R b/code/MOSuite/tests/testthat/test-clean.R index 475c239..40197a6 100644 --- a/code/MOSuite/tests/testthat/test-clean.R +++ b/code/MOSuite/tests/testthat/test-clean.R @@ -67,6 +67,193 @@ test_that("clean_raw_counts works for RENEE data", { ) }) +test_that("clean_raw_counts plots CPM histogram after cleaning without all-zero genes", { + captured_histogram_counts <- NULL + histogram_args <- NULL + saved_filenames <- character() + group_colors <- c(A = "red", B = "blue") + + local_mocked_bindings( + plot_histogram = function(moo_counts, ...) { + captured_histogram_counts <<- moo_counts + histogram_args <<- list(...) + ggplot2::ggplot() + }, + print_or_save_plot = function(plot, filename, ...) { + saved_filenames <<- c(saved_filenames, basename(filename)) + invisible(NULL) + }, + .package = "MOSuite" + ) + + counts_dat <- data.frame( + GeneName = c("all_zero", "keep_one", "keep_one"), + S1 = c(0, 10, 5), + S2 = c(0, 0, 5), + check.names = FALSE + ) + sample_metadata <- data.frame( + Sample = c("S1", "S2"), + Group = c("A", "B"), + check.names = FALSE + ) + + create_multiOmicDataSet_from_dataframes( + sample_metadata = sample_metadata, + counts_dat = counts_dat, + sample_id_colname = "Sample", + feature_id_colname = "GeneName" + ) |> + clean_raw_counts( + sample_id_colname = "Sample", + feature_id_colname = "GeneName", + group_colname = "Group", + colors_for_plots = group_colors, + split_gene_name = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expect_true("read_depth.png" %in% saved_filenames) + expect_true("cpm_histogram.png" %in% saved_filenames) + expect_equal(captured_histogram_counts$GeneName, "keep_one") + expect_equal(captured_histogram_counts$S1, 1e6) + expect_equal(captured_histogram_counts$S2, 1e6) + expect_equal(histogram_args$group_colname, "Group") + expect_equal(histogram_args$color_values, group_colors) + expect_true(histogram_args$color_by_group) +}) + +test_that("strip_ensembl_version removes version suffix", { + ids <- c("ENSG00000121410.11", "ENSG00000268895.5", "ENSG00000148584.15") + result <- MOSuite:::strip_ensembl_version(ids) + expect_equal( + result, + c("ENSG00000121410", "ENSG00000268895", "ENSG00000148584") + ) +}) + +test_that("strip_ensembl_version is a no-op for IDs without version", { + ids <- c("ENSG00000121410", "ENSG00000268895") + result <- MOSuite:::strip_ensembl_version(ids) + expect_equal(result, ids) +}) + +test_that("separate_gene_meta_columns splits Ensembl|GeneName format", { + counts_dat <- data.frame( + `ENSG00000121410|A1BG` = c(10, 20), + sample1 = c(100, 200), + check.names = FALSE + ) + colnames(counts_dat)[1] <- "ENSG00000121410|A1BG" + # Rename so first col is the feature ID + counts_dat2 <- data.frame( + feature_id = c("ENSG00000121410|A1BG", "ENSG00000268895|A1BG-AS1"), + sample1 = c(100, 200), + stringsAsFactors = FALSE + ) + result <- MOSuite:::separate_gene_meta_columns( + counts_dat2, + split_gene_name = TRUE + ) + expect_true("Ensembl_ID" %in% colnames(result)) + expect_equal(result$Ensembl_ID, c("ENSG00000121410", "ENSG00000268895")) +}) + +test_that("separate_gene_meta_columns strips Ensembl version when present", { + counts_dat <- data.frame( + feature_id = c("ENSG00000121410.11|A1BG", "ENSG00000268895.5|A1BG-AS1"), + sample1 = c(100, 200), + stringsAsFactors = FALSE + ) + result <- MOSuite:::separate_gene_meta_columns( + counts_dat, + split_gene_name = TRUE + ) + expect_true("Ensembl_ID" %in% colnames(result)) + expect_true("Ensembl_ID_version" %in% colnames(result)) + expect_equal(result$Ensembl_ID, c("ENSG00000121410", "ENSG00000268895")) + expect_equal( + result$Ensembl_ID_version, + c("ENSG00000121410.11", "ENSG00000268895.5") + ) +}) + +test_that("separate_gene_meta_columns uses Feature_id_1/2 when format unknown", { + counts_dat <- data.frame( + feature_id = c("geneA|isoform1", "geneB|isoform2"), + sample1 = c(10, 20), + stringsAsFactors = FALSE + ) + result <- MOSuite:::separate_gene_meta_columns( + counts_dat, + split_gene_name = TRUE + ) + expect_true("Feature_id_1" %in% colnames(result)) + expect_true("Feature_id_2" %in% colnames(result)) +}) + +test_that("separate_gene_meta_columns does not split when split_gene_name = FALSE", { + counts_dat <- data.frame( + feature_id = c("ENSG00000121410|A1BG", "ENSG00000268895|other"), + sample1 = c(10, 20), + stringsAsFactors = FALSE + ) + result <- MOSuite:::separate_gene_meta_columns( + counts_dat, + split_gene_name = FALSE + ) + expect_equal(colnames(result)[1], "feature_id") + expect_equal(ncol(result), 2) +}) + +test_that("clean_raw_counts cleans column names with special characters", { + counts_dat <- data.frame( + GeneName = c("geneA", "geneB"), + `sample-1` = c(10, 20), + `sample 2` = c(30, 40), + check.names = FALSE + ) + meta <- data.frame(Sample = c("sample-1", "sample 2")) + moo <- create_multiOmicDataSet_from_dataframes( + sample_metadata = meta, + counts_dat = counts_dat, + sample_id_colname = "Sample" + ) + result <- clean_raw_counts( + moo, + sample_id_colname = "Sample", + feature_id_colname = "GeneName", + cleanup_column_names = TRUE + ) + clean_cols <- colnames(result@counts$clean) + expect_false(any(grepl("-| ", clean_cols))) +}) + +test_that("clean_raw_counts prefixes numeric-starting column names with X", { + counts_dat <- data.frame( + GeneName = c("geneA", "geneB"), + `1sample` = c(10, 20), + `2sample` = c(30, 40), + check.names = FALSE + ) + meta <- data.frame(Sample = c("1sample", "2sample")) + moo <- create_multiOmicDataSet_from_dataframes( + sample_metadata = meta, + counts_dat = counts_dat, + sample_id_colname = "Sample" + ) + result <- clean_raw_counts( + moo, + sample_id_colname = "Sample", + feature_id_colname = "GeneName", + cleanup_column_names = TRUE + ) + clean_cols <- colnames(result@counts$clean) + expect_false(any(grepl("^[0-9]", clean_cols))) + expect_true(any(grepl("^X[0-9]", clean_cols))) +}) + test_that("aggregate_duplicate_gene_names returns collapsed dfout", { counts_dat <- data.frame( gene_id = c("A", "A", "B"), diff --git a/code/MOSuite/tests/testthat/test-colors.R b/code/MOSuite/tests/testthat/test-colors.R index 3aea8b4..67b7290 100644 --- a/code/MOSuite/tests/testthat/test-colors.R +++ b/code/MOSuite/tests/testthat/test-colors.R @@ -13,65 +13,60 @@ test_that("get_colors_lst works on nidap_sample_metadata", { get_colors_lst(nidap_sample_metadata), list( Sample = c( - A1 = "#000000", - A2 = "#E69F00", - A3 = "#56B4E9", - B1 = "#009E73", - B2 = "#F0E442", - B3 = "#0072B2", - C1 = "#D55E00", - C2 = "#CC79A7", - C3 = "#999999" + A1 = "#5954d6", + A2 = "#e1562c", + A3 = "#b80058", + B1 = "#00c6f8", + B2 = "#d163e6", + B3 = "#00a76c", + C1 = "#ff9287", + C2 = "#008cf9", + C3 = "#006e00" ), Group = c( - A = "#000000", - B = "#E69F00", - C = "#56B4E9" + A = "#5954d6", + B = "#e1562c", + C = "#b80058" ), Replicate = c( - `1` = "#000000", - `2` = "#E69F00", - `3` = "#56B4E9" + `1` = "#00c6f8", + `2` = "#d163e6", + `3` = "#00a76c" ), - Batch = c(`1` = "#000000", `2` = "#E69F00"), + Batch = c(`1` = "#ff9287", `2` = "#008cf9"), Label = c( - A1 = "#000000", - A2 = "#E69F00", - A3 = "#56B4E9", - B1 = "#009E73", - B2 = "#F0E442", - B3 = "#0072B2", - C1 = "#D55E00", - C2 = "#CC79A7", - C3 = "#999999" + A1 = "#5954d6", + A2 = "#e1562c", + A3 = "#b80058", + B1 = "#00c6f8", + B2 = "#d163e6", + B3 = "#00a76c", + C1 = "#ff9287", + C2 = "#008cf9", + C3 = "#006e00" ) ) ) }) -test_that("get_colors_lst handles alternative palette functions", { +test_that("get_colors_lst handles alternative palette vectors", { sample_meta <- system.file( "extdata", "sample_metadata.tsv.gz", package = "MOSuite" ) |> readr::read_tsv() - expect_message( - expect_warning( - get_colors_lst( - sample_meta, - palette_fun = RColorBrewer::brewer.pal, - name = "Set3" - ), - "minimal value for n is 3" - ), - "Warning raised in " + result <- get_colors_lst( + sample_meta, + palette = RColorBrewer::brewer.pal(12, "Set3") ) + expect_type(result, "list") + expect_length(result, ncol(sample_meta)) }) test_that("get_colors_vctr falls back to random colors when n exceeds palette max", { - # Okabe-Ito palette has a maximum of 9 colors. When n > 9, the function + # MOSuite's default palette has 12 colors. When n > 12, the function # should fall back to get_random_colors() and emit a message. dat_many_cats <- data.frame( - group = paste0("cat", seq_len(12)) + group = paste0("cat", seq_len(13)) ) expect_no_warning( expect_message( @@ -79,8 +74,204 @@ test_that("get_colors_vctr falls back to random colors when n exceeds palette ma "exceeds the palette maximum" ) ) - expect_length(result, 12) - expect_named(result, paste0("cat", seq_len(12))) + expect_length(result, 13) + expect_named(result, paste0("cat", seq_len(13))) +}) + +test_that("get_colors_vctr retries from offset 0 when offset pushes past palette end", { + # Palette has 12 colors; offset=10, n_obs=5: 10+5=15 > 12, so retry without offset. + # The column should receive palette colors 1-5, not random colors. + dat <- data.frame(group = paste0("x", seq_len(5))) + result <- get_colors_vctr(dat, "group", color_offset = 10L) + expect_length(result, 5) + expect_named(result, paste0("x", seq_len(5))) + # Should get the first 5 palette colors (same as offset=0), not random + expected <- get_colors_vctr(dat, "group", color_offset = 0L) + expect_equal(result, expected) +}) + +test_that("get_colors_lst columns exceeding palette size fall back to random colors", { + # 13 unique values exceeds the 12-color mosuite_palette; should message and use random colors + dat_big <- data.frame(group = paste0("cat", seq_len(13))) + expect_no_warning( + expect_message( + result <- get_colors_lst(dat_big), + "exceeds the palette maximum" + ) + ) + expect_length(result$group, 13) + expect_named(result$group, paste0("cat", seq_len(13))) +}) + +test_that("resolve_plot_colors preserves named color mappings", { + dat <- data.frame(group = c("B", "A", "C", "A")) + colors <- c(A = "red", B = "blue", C = "green") + + expect_equal(resolve_plot_colors(dat, "group", colors), colors) +}) + +test_that("resolve_plot_colors names palettes by first observed category order", { + dat <- data.frame(group = c("B", "A", "C", "A")) + colors <- c("red", "blue", "green") + + expect_equal( + resolve_plot_colors(dat, "group", colors), + c(B = "red", A = "blue", C = "green") + ) +}) + +test_that("color vectors use factor level order when grouping column is a factor", { + dat <- data.frame( + group = factor(c("B", "A", "C", "A"), levels = c("C", "A", "B", "D")) + ) + + expect_equal( + get_colors_vctr(dat, "group"), + c(C = "#5954d6", A = "#e1562c", B = "#b80058") + ) + expect_equal( + resolve_plot_colors(dat, "group", c("red", "blue", "green")), + c(C = "red", A = "blue", B = "green") + ) +}) + +test_that("resolve_plot_colors generates colors when none are supplied", { + dat <- data.frame(group = c("B", "A", "C", "A")) + + expect_equal( + resolve_plot_colors(dat, "group"), + c(B = "#5954d6", A = "#e1562c", C = "#b80058") + ) +}) + +test_that("resolve_plot_colors generates additional colors for too few explicit colors", { + dat <- data.frame(group = c("B", "A", "C", "A")) + + expect_message( + result <- resolve_plot_colors(dat, "group", c("red", "blue")), + "Generating 1 additional colors" + ) + expect_named(result, c("B", "A", "C")) + expect_equal(unname(result[1:2]), c("red", "blue")) + expect_equal(unname(result[3]), "#b80058") +}) + +test_that("resolve_plot_colors uses random fallback only through get_colors_vctr", { + dat <- data.frame(group = paste0("cat", seq_len(13))) + colors <- c( + "#5954d6", + "#e1562c", + "#b80058", + "#00c6f8", + "#d163e6", + "#00a76c", + "#ff9287", + "#008cf9", + "#006e00", + "#796880", + "#FFA500", + "#878500" + ) + + expect_message( + expect_message( + result <- resolve_plot_colors(dat, "group", colors), + "Generating 1 additional colors" + ), + "exceeds the palette maximum" + ) + expect_named(result, paste0("cat", seq_len(13))) + expect_equal(unname(result[seq_along(colors)]), colors) + expect_match(unname(result[13]), "^#[0-9A-F]{6}$") +}) + +test_that("resolve_plot_colors treats non-matching names as palette labels", { + dat <- data.frame(group = c("B", "A", "C", "A")) + + expect_equal( + resolve_plot_colors( + dat, + "group", + c(indigo = "red", carrot = "blue", jade = "green") + ), + c(B = "red", A = "blue", C = "green") + ) +}) + +test_that("select_mosuite_colors returns n colors from mosuite_palette", { + result <- select_mosuite_colors(3) + expect_length(result, 3) + expect_true(all(grepl("^#", result))) +}) + +test_that("select_mosuite_colors clamps to palette length when n exceeds it", { + pal_len <- length(mosuite_palette) + result <- select_mosuite_colors(pal_len + 10) + expect_length(result, pal_len) +}) + +test_that("get_observed_values drops NAs and returns unique values in first-seen order", { + dat <- data.frame(group = c("B", NA, "A", "B", NA)) + result <- MOSuite:::get_observed_values(dat, "group") + expect_equal(result, c("B", "A")) +}) + +test_that("get_observed_values respects factor level order and excludes unseen levels", { + dat <- data.frame( + group = factor(c("B", "A", NA), levels = c("C", "A", "B", "D")) + ) + result <- MOSuite:::get_observed_values(dat, "group") + # "C" and "D" are levels but never observed; should be excluded + expect_equal(result, c("A", "B")) +}) + +test_that("get_colors_vctr returns empty character vector when column has zero observed values", { + expect_equal( + get_colors_vctr(data.frame(group = character(0)), "group"), + character(0) + ) + expect_equal( + get_colors_vctr( + data.frame(group = c(NA_character_, NA_character_)), + "group" + ), + character(0) + ) +}) + +test_that("get_colors_vctr handles a column with NA values", { + dat <- data.frame(group = c("A", NA, "B", "A")) + result <- get_colors_vctr(dat, "group") + expect_length(result, 2) + expect_named(result, c("A", "B")) +}) + +test_that("resolve_plot_colors returns color_values unchanged when column has no observations", { + dat <- data.frame(group = character(0)) + colors <- c(A = "red") + result <- MOSuite:::resolve_plot_colors(dat, "group", color_values = colors) + expect_equal(result, colors) +}) + +test_that("resolve_plot_colors returns color_values unchanged when column is all NA", { + dat <- data.frame(group = c(NA_character_, NA_character_)) + colors <- c(A = "red") + result <- MOSuite:::resolve_plot_colors(dat, "group", color_values = colors) + expect_equal(result, colors) +}) + +test_that("display_palette returns a ggplot invisibly", { + result <- display_palette(c("#FF0000", "#00FF00", "#0000FF")) + expect_s3_class(result, "gg") +}) + +test_that("display_colors returns a patchwork object", { + moo <- create_multiOmicDataSet_from_dataframes( + sample_metadata = as.data.frame(nidap_sample_metadata), + counts_dat = as.data.frame(nidap_raw_counts) + ) + result <- display_colors(moo) + expect_s3_class(result, "patchwork") }) test_that("set_color_pal overrides the color palette", { @@ -92,59 +283,58 @@ test_that("set_color_pal overrides the color palette", { moo@analyses$colors, list( Sample = c( - A1 = "#000000", - A2 = "#E69F00", - A3 = "#56B4E9", - B1 = "#009E73", - B2 = "#F0E442", - B3 = "#0072B2", - C1 = "#D55E00", - C2 = "#CC79A7", - C3 = "#999999" + A1 = "#5954d6", + A2 = "#e1562c", + A3 = "#b80058", + B1 = "#00c6f8", + B2 = "#d163e6", + B3 = "#00a76c", + C1 = "#ff9287", + C2 = "#008cf9", + C3 = "#006e00" ), Group = c( - A = "#000000", - B = "#E69F00", - C = "#56B4E9" + A = "#5954d6", + B = "#e1562c", + C = "#b80058" ), Replicate = c( - `1` = "#000000", - `2` = "#E69F00", - `3` = "#56B4E9" + `1` = "#00c6f8", + `2` = "#d163e6", + `3` = "#00a76c" ), - Batch = c(`1` = "#000000", `2` = "#E69F00"), + Batch = c(`1` = "#ff9287", `2` = "#008cf9"), Label = c( - A1 = "#000000", - A2 = "#E69F00", - A3 = "#56B4E9", - B1 = "#009E73", - B2 = "#F0E442", - B3 = "#0072B2", - C1 = "#D55E00", - C2 = "#CC79A7", - C3 = "#999999" + A1 = "#5954d6", + A2 = "#e1562c", + A3 = "#b80058", + B1 = "#00c6f8", + B2 = "#d163e6", + B3 = "#00a76c", + C1 = "#ff9287", + C2 = "#008cf9", + C3 = "#006e00" ) ) ) moo2 <- moo |> set_color_pal( colname = "Group", - palette_fun = RColorBrewer::brewer.pal, - name = "Set2" + palette = RColorBrewer::brewer.pal(3, "Set2") ) expect_equal( moo2@analyses$colors, list( Sample = c( - A1 = "#000000", - A2 = "#E69F00", - A3 = "#56B4E9", - B1 = "#009E73", - B2 = "#F0E442", - B3 = "#0072B2", - C1 = "#D55E00", - C2 = "#CC79A7", - C3 = "#999999" + A1 = "#5954d6", + A2 = "#e1562c", + A3 = "#b80058", + B1 = "#00c6f8", + B2 = "#d163e6", + B3 = "#00a76c", + C1 = "#ff9287", + C2 = "#008cf9", + C3 = "#006e00" ), Group = c( A = "#66C2A5", @@ -152,21 +342,21 @@ test_that("set_color_pal overrides the color palette", { C = "#8DA0CB" ), Replicate = c( - `1` = "#000000", - `2` = "#E69F00", - `3` = "#56B4E9" + `1` = "#00c6f8", + `2` = "#d163e6", + `3` = "#00a76c" ), - Batch = c(`1` = "#000000", `2` = "#E69F00"), + Batch = c(`1` = "#ff9287", `2` = "#008cf9"), Label = c( - A1 = "#000000", - A2 = "#E69F00", - A3 = "#56B4E9", - B1 = "#009E73", - B2 = "#F0E442", - B3 = "#0072B2", - C1 = "#D55E00", - C2 = "#CC79A7", - C3 = "#999999" + A1 = "#5954d6", + A2 = "#e1562c", + A3 = "#b80058", + B1 = "#00c6f8", + B2 = "#d163e6", + B3 = "#00a76c", + C1 = "#ff9287", + C2 = "#008cf9", + C3 = "#006e00" ) ) ) diff --git a/code/MOSuite/tests/testthat/test-filter.R b/code/MOSuite/tests/testthat/test-filter.R index aabfc78..3fccbd0 100644 --- a/code/MOSuite/tests/testthat/test-filter.R +++ b/code/MOSuite/tests/testthat/test-filter.R @@ -203,6 +203,227 @@ test_that("remove_low_count_genes works", { ) }) +test_that("remove_low_count_genes counts threshold values inclusively", { + df <- data.frame( + Gene = c("exact_keep", "below_minimum", "above_keep"), + S1 = c(4, 4, 5), + S2 = c(5, 0, 5), + S3 = c(0, 0, 0), + check.names = FALSE + ) + sample_meta <- data.frame( + Sample = c("S1", "S2", "S3"), + Group = c("A", "A", "A"), + row.names = c("S1", "S2", "S3"), + check.names = FALSE + ) + + result <- remove_low_count_genes( + counts_dat = df, + sample_metadata = sample_meta, + feature_id_colname = "Gene", + group_colname = "Group", + use_cpm_counts_to_filter = FALSE, + use_group_based_filtering = FALSE, + minimum_count_value_to_be_considered_nonzero = 4, + minimum_number_of_samples_with_nonzero_counts_in_total = 2, + minimum_number_of_samples_with_nonzero_counts_in_a_group = 2 + ) + + expect_equal(result$Gene, c("exact_keep", "above_keep")) +}) + +test_that("remove_low_count_genes uses original filter threshold parameters", { + df <- data.frame( + Gene = c("keep", "remove"), + S1 = c(4, 4), + S2 = c(4, 0), + check.names = FALSE + ) + sample_meta <- data.frame( + Sample = c("S1", "S2"), + Group = c("A", "A"), + row.names = c("S1", "S2"), + check.names = FALSE + ) + + result <- remove_low_count_genes( + counts_dat = df, + sample_metadata = sample_meta, + feature_id_colname = "Gene", + group_colname = "Group", + use_cpm_counts_to_filter = FALSE, + use_group_based_filtering = FALSE, + minimum_count_value_to_be_considered_nonzero = 4, + minimum_number_of_samples_with_nonzero_counts_in_total = 2, + minimum_number_of_samples_with_nonzero_counts_in_a_group = 2 + ) + + expect_equal(result$Gene, "keep") +}) + +test_that("remove_low_count_genes ignores non-numeric annotation columns", { + df <- data.frame( + Gene = c("keep", "remove"), + Symbol = c("A", "B"), + S1 = c(4, 4), + S2 = c(4, 0), + check.names = FALSE + ) + sample_meta <- data.frame( + Sample = c("S1", "S2"), + Group = c("A", "A"), + row.names = c("S1", "S2"), + check.names = FALSE + ) + + result <- remove_low_count_genes( + counts_dat = df, + sample_metadata = sample_meta, + feature_id_colname = "Gene", + group_colname = "Group", + use_cpm_counts_to_filter = FALSE, + use_group_based_filtering = FALSE, + minimum_count_value_to_be_considered_nonzero = 4, + minimum_number_of_samples_with_nonzero_counts_in_total = 2, + minimum_number_of_samples_with_nonzero_counts_in_a_group = 2 + ) + + expect_equal(result$Gene, "keep") + expect_equal(result$Symbol, "A") +}) + +test_that("remove_low_count_genes distinguishes total sample minimum 8 from 9", { + sample_names <- paste0("S", 1:10) + df <- data.frame( + Gene = c("passes_exactly_eight", "passes_nine"), + S1 = c(4, 4), + S2 = c(4, 4), + S3 = c(4, 4), + S4 = c(4, 4), + S5 = c(4, 4), + S6 = c(4, 4), + S7 = c(4, 4), + S8 = c(4, 4), + S9 = c(0, 4), + S10 = c(0, 0), + check.names = FALSE + ) + sample_meta <- data.frame( + Sample = sample_names, + Group = rep("A", length(sample_names)), + row.names = sample_names, + check.names = FALSE + ) + + total_8 <- remove_low_count_genes( + counts_dat = df, + sample_metadata = sample_meta, + feature_id_colname = "Gene", + group_colname = "Group", + use_cpm_counts_to_filter = FALSE, + use_group_based_filtering = FALSE, + minimum_count_value_to_be_considered_nonzero = 4, + minimum_number_of_samples_with_nonzero_counts_in_total = 8, + minimum_number_of_samples_with_nonzero_counts_in_a_group = 2 + ) + total_9 <- remove_low_count_genes( + counts_dat = df, + sample_metadata = sample_meta, + feature_id_colname = "Gene", + group_colname = "Group", + use_cpm_counts_to_filter = FALSE, + use_group_based_filtering = FALSE, + minimum_count_value_to_be_considered_nonzero = 4, + minimum_number_of_samples_with_nonzero_counts_in_total = 9, + minimum_number_of_samples_with_nonzero_counts_in_a_group = 2 + ) + + expect_equal(total_8$Gene, c("passes_exactly_eight", "passes_nine")) + expect_equal(total_9$Gene, "passes_nine") +}) + +test_that("remove_low_count_genes applies sample minimum within groups", { + df <- data.frame( + Gene = c( + "group_exact_keep", + "split_across_groups", + "one_group_keep", + "single_sample_total_only" + ), + S1 = c(4, 4, 0, 5), + S2 = c(4, 0, 0, 0), + S3 = c(0, 4, 5, 0), + S4 = c(0, 0, 4, 0), + check.names = FALSE + ) + sample_meta <- data.frame( + Sample = c("S1", "S2", "S3", "S4"), + Group = c("A", "A", "B", "B"), + row.names = paste0("metadata_row_", 1:4), + check.names = FALSE + ) + + group_result <- remove_low_count_genes( + counts_dat = df, + sample_metadata = sample_meta, + feature_id_colname = "Gene", + group_colname = "Group", + use_cpm_counts_to_filter = FALSE, + use_group_based_filtering = TRUE, + minimum_count_value_to_be_considered_nonzero = 4, + minimum_number_of_samples_with_nonzero_counts_in_total = 1, + minimum_number_of_samples_with_nonzero_counts_in_a_group = 2 + ) + non_group_result <- remove_low_count_genes( + counts_dat = df, + sample_metadata = sample_meta, + feature_id_colname = "Gene", + group_colname = "Group", + use_cpm_counts_to_filter = FALSE, + use_group_based_filtering = FALSE, + minimum_count_value_to_be_considered_nonzero = 4, + minimum_number_of_samples_with_nonzero_counts_in_total = 2, + minimum_number_of_samples_with_nonzero_counts_in_a_group = 2 + ) + + expect_equal(group_result$Gene, c("group_exact_keep", "one_group_keep")) + expect_equal( + non_group_result$Gene, + c("group_exact_keep", "split_across_groups", "one_group_keep") + ) +}) + +test_that("remove_low_count_genes ignores missing group assignments", { + df <- data.frame( + Gene = c("keep", "remove"), + S1 = c(4, 4), + S2 = c(4, 0), + S3 = c(0, 4), + check.names = FALSE + ) + sample_meta <- data.frame( + Sample = c("S1", "S2", "S3"), + Group = c("A", "A", NA), + row.names = c("S1", "S2", "S3"), + check.names = FALSE + ) + + result <- remove_low_count_genes( + counts_dat = df, + sample_metadata = sample_meta, + feature_id_colname = "Gene", + group_colname = "Group", + use_cpm_counts_to_filter = FALSE, + use_group_based_filtering = TRUE, + minimum_count_value_to_be_considered_nonzero = 4, + minimum_number_of_samples_with_nonzero_counts_in_total = 1, + minimum_number_of_samples_with_nonzero_counts_in_a_group = 2 + ) + + expect_equal(result$Gene, "keep") +}) + test_that("remove_low_count_genes works with group-based filtering (no grouped tibble crash)", { df <- data.frame( Gene = c( @@ -251,3 +472,421 @@ test_that("remove_low_count_genes works with group-based filtering (no grouped t expect_true("Gene" %in% colnames(result)) expect_true(nrow(result) > 0) }) + +test_that("filter_counts forwards plotting parameters", { + pca_args <- NULL + histogram_args <- NULL + + local_mocked_bindings( + plot_pca = function(...) { + pca_args <<- list(...) + return(ggplot2::ggplot()) + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + return(ggplot2::ggplot()) + }, + print_or_save_plot = function(...) invisible(NULL), + .package = "MOSuite" + ) + + moo <- create_multiOmicDataSet_from_dataframes( + as.data.frame(nidap_sample_metadata), + as.data.frame(nidap_clean_raw_counts), + sample_id_colname = "Sample", + feature_id_colname = "Gene" + ) |> + calc_cpm(feature_id_colname = "Gene") + + filter_counts( + moo, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + label_colname = "Label", + count_type = "raw", + samples_to_rename = c("A1:Alpha 1"), + add_label_to_pca = FALSE, + principal_component_on_x_axis = 2, + principal_component_on_y_axis = 3, + legend_position_for_pca = "bottom", + label_offset_x_ = 4, + label_offset_y_ = 5, + label_font_size = 6, + point_size_for_pca = 7, + color_histogram_by_group = TRUE, + set_min_max_for_x_axis_for_histogram = TRUE, + minimum_for_x_axis_for_histogram = -2, + maximum_for_x_axis_for_histogram = 2, + legend_font_size_for_histogram = 11, + legend_position_for_histogram = "right", + number_of_histogram_legend_columns = 2, + colors_for_plots = c(A = "red", B = "blue", C = "green"), + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expect_equal(pca_args$samples_to_rename, c("A1:Alpha 1")) + expect_equal(pca_args$principal_components, c(2, 3)) + expect_equal(pca_args$legend_position, "bottom") + expect_equal(pca_args$point_size, 7) + expect_null(pca_args$label_colname) + expect_equal(pca_args$label_font_size, 6) + expect_equal(pca_args$label_offset_x_, 4) + expect_equal(pca_args$label_offset_y_, 5) + expect_equal(pca_args$color_values, c(A = "red", B = "blue", C = "green")) + + expect_true(histogram_args$color_by_group) + expect_true(histogram_args$set_min_max_for_x_axis) + expect_equal(histogram_args$minimum_for_x_axis, -2) + expect_equal(histogram_args$maximum_for_x_axis, 2) + expect_equal(histogram_args$x_axis_label, "CPM") + expect_equal(histogram_args$legend_font_size, 11) + expect_equal(histogram_args$legend_position, "right") + expect_equal(histogram_args$number_of_legend_columns, 2) + expect_equal( + histogram_args$color_values, + c(A = "red", B = "blue", C = "green") + ) + + pca_args <- NULL + filter_counts( + moo, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + label_colname = "Label", + count_type = "raw", + add_label_to_pca = TRUE, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + expect_equal(pca_args$label_colname, "Label") +}) + +test_that("filter_counts handles histogram label combinations", { + pca_args <- NULL + histogram_args <- NULL + group_colors <- c(A = "red", B = "blue", C = "green") + + local_mocked_bindings( + plot_pca = function(...) { + pca_args <<- list(...) + return(ggplot2::ggplot()) + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + return(ggplot2::ggplot()) + }, + print_or_save_plot = function(...) invisible(NULL), + .package = "MOSuite" + ) + + moo <- create_multiOmicDataSet_from_dataframes( + as.data.frame(nidap_sample_metadata), + as.data.frame(nidap_clean_raw_counts), + sample_id_colname = "Sample", + feature_id_colname = "Gene" + ) |> + calc_cpm(feature_id_colname = "Gene") + + combinations <- list( + list( + label_colname = NULL, + color_histogram_by_group = FALSE, + interactive_plots = FALSE + ), + list( + label_colname = NULL, + color_histogram_by_group = FALSE, + interactive_plots = TRUE + ), + list( + label_colname = NULL, + color_histogram_by_group = TRUE, + interactive_plots = FALSE + ), + list( + label_colname = NULL, + color_histogram_by_group = TRUE, + interactive_plots = TRUE + ), + list( + label_colname = "Label", + color_histogram_by_group = FALSE, + interactive_plots = FALSE + ), + list( + label_colname = "Label", + color_histogram_by_group = FALSE, + interactive_plots = TRUE + ), + list( + label_colname = "Label", + color_histogram_by_group = TRUE, + interactive_plots = FALSE + ), + list( + label_colname = "Label", + color_histogram_by_group = TRUE, + interactive_plots = TRUE + ) + ) + + for (combination in combinations) { + pca_args <- NULL + histogram_args <- NULL + filter_counts( + moo, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + label_colname = combination$label_colname, + count_type = "raw", + color_histogram_by_group = combination$color_histogram_by_group, + interactive_plots = combination$interactive_plots, + colors_for_plots = group_colors, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expected_label_colname <- if (is.null(combination$label_colname)) { + "Sample" + } else { + combination$label_colname + } + expected_histogram_colors <- if ( + isTRUE(combination$color_histogram_by_group) + ) { + group_colors + } else { + moo@analyses[["colors"]][[expected_label_colname]] + } + + expect_equal(pca_args$label_colname, combination$label_colname) + expect_equal(histogram_args$label_colname, expected_label_colname) + expect_equal( + histogram_args$color_by_group, + combination$color_histogram_by_group + ) + expect_equal( + histogram_args$interactive_plots, + combination$interactive_plots + ) + expect_equal(histogram_args$color_values, expected_histogram_colors) + } +}) + +test_that("filter_counts forwards the default MOSuite plot colors", { + pca_args <- NULL + histogram_args <- NULL + default_colors <- c( + "A" = "#5954d6", + "B" = "#e1562c", + "C" = "#b80058" + ) + + local_mocked_bindings( + plot_pca = function(...) { + pca_args <<- list(...) + return(ggplot2::ggplot()) + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + return(ggplot2::ggplot()) + }, + print_or_save_plot = function(...) invisible(NULL), + .package = "MOSuite" + ) + + moo <- create_multiOmicDataSet_from_dataframes( + as.data.frame(nidap_sample_metadata), + as.data.frame(nidap_clean_raw_counts), + sample_id_colname = "Sample", + feature_id_colname = "Gene" + ) |> + calc_cpm(feature_id_colname = "Gene") + + filter_counts( + moo, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + label_colname = "Label", + count_type = "raw", + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expect_equal(pca_args$color_values, default_colors) + expect_equal(histogram_args$color_values, default_colors) +}) + +test_that("filter_counts adds a dotted threshold line and label to the histogram", { + histogram_plot <- NULL + histogram_args <- NULL + + local_mocked_bindings( + plot_pca = function(...) { + return(ggplot2::ggplot()) + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + return(ggplot2::ggplot()) + }, + print_or_save_plot = function(plot, filename, ...) { + if (basename(filename) == "histogram.png") { + histogram_plot <<- plot + } + return(invisible(NULL)) + }, + .package = "MOSuite" + ) + + moo <- create_multiOmicDataSet_from_dataframes( + as.data.frame(nidap_sample_metadata), + as.data.frame(nidap_clean_raw_counts), + sample_id_colname = "Sample", + feature_id_colname = "Gene" + ) + + filter_counts( + moo, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + label_colname = "Label", + count_type = "raw", + minimum_count_value_to_be_considered_nonzero = 4, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + histogram_data <- ggplot2::ggplot_build(histogram_plot)$data + + expect_true(histogram_args$use_log2_x_axis) + expect_true(histogram_args$return_ggplot) + expect_equal(histogram_data[[1]]$xintercept, 4 + 0.5) + expect_equal(histogram_data[[1]]$linetype, 2) + expect_equal(histogram_data[[1]]$linewidth, 1) + expect_equal(histogram_data[[2]]$x, 4 + 0.5) + expect_equal(histogram_data[[2]]$label, "CPM: 4") +}) + +test_that("filter_counts PCA matches standalone plot_pca on filtered output", { + pca_capture <- capture_saved_pca_plot() + local_mocked_bindings( + print_or_save_plot = pca_capture$print_or_save_plot, + .package = "MOSuite" + ) + + moo <- create_multiOmicDataSet_from_dataframes( + as.data.frame(nidap_sample_metadata), + as.data.frame(nidap_clean_raw_counts), + sample_id_colname = "Sample", + feature_id_colname = "Gene" + ) |> + filter_counts( + sample_id_colname = "Sample", + feature_id_colname = "Gene", + label_colname = NULL, + count_type = "raw", + use_cpm_counts_to_filter = FALSE, + minimum_count_value_to_be_considered_nonzero = 8, + minimum_number_of_samples_with_nonzero_counts_in_total = 7, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expected_pca <- plot_pca( + moo@counts$filt, + sample_metadata = moo@sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + label_colname = NULL, + samples_to_rename = c(""), + principal_components = c(1, 2), + legend_position = "top", + point_size = 5, + label_font_size = 3, + label_offset_y_ = 2, + label_offset_x_ = 2, + log_transform = TRUE, + log_transform_pseudocount = 0.5, + log_transform_base = "ln", + print_plots = FALSE, + save_plots = FALSE + ) + + expect_s3_class(pca_capture$get(), "ggplot") + expect_pca_coordinates_equal(pca_capture$get(), expected_pca) +}) + +test_that("filter_counts histogram matches standalone plot_histogram on filtered output", { + histogram_capture <- capture_saved_histogram_plot() + local_mocked_bindings( + print_or_save_plot = histogram_capture$print_or_save_plot, + .package = "MOSuite" + ) + + moo <- create_multiOmicDataSet_from_dataframes( + as.data.frame(nidap_sample_metadata), + as.data.frame(nidap_clean_raw_counts), + sample_id_colname = "Sample", + feature_id_colname = "Gene" + ) |> + filter_counts( + sample_id_colname = "Sample", + feature_id_colname = "Gene", + label_colname = NULL, + count_type = "raw", + use_cpm_counts_to_filter = FALSE, + minimum_count_value_to_be_considered_nonzero = 8, + minimum_number_of_samples_with_nonzero_counts_in_total = 7, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE, + interactive_plots = FALSE + ) + + histogram_threshold_x <- 8 + 0.5 + expected_histogram <- plot_histogram( + moo@counts$filt, + sample_metadata = moo@sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + label_colname = NULL, + color_by_group = TRUE, + set_min_max_for_x_axis = FALSE, + minimum_for_x_axis = -1, + maximum_for_x_axis = 1, + x_axis_label = "Count", + legend_position = "top", + legend_font_size = NULL, + number_of_legend_columns = 6, + interactive_plots = FALSE, + return_ggplot = TRUE, + use_log2_x_axis = TRUE + ) + + ggplot2::labs(caption = "filtered counts") + + ggplot2::geom_vline( + xintercept = histogram_threshold_x, + linetype = 2, + linewidth = 1 + ) + + ggplot2::annotate( + "text", + x = histogram_threshold_x, + y = Inf, + label = "Count: 8", + hjust = -0.05, + vjust = 1.5, + size = 3 + ) + + expect_s3_class(histogram_capture$get(), "ggplot") + expect_histogram_layers_equal(histogram_capture$get(), expected_histogram) +}) diff --git a/code/MOSuite/tests/testthat/test-normalize.R b/code/MOSuite/tests/testthat/test-normalize.R index 87318d4..46f7182 100644 --- a/code/MOSuite/tests/testthat/test-normalize.R +++ b/code/MOSuite/tests/testthat/test-normalize.R @@ -137,3 +137,346 @@ test_that("normalize works for RENEE", { ) ) }) + +test_that("normalize_counts forwards plotting parameters", { + pca_args <- NULL + histogram_args <- NULL + + local_mocked_bindings( + plot_pca = function(...) { + pca_args <<- list(...) + ggplot2::ggplot() + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + ggplot2::ggplot() + }, + print_or_save_plot = function(...) invisible(NULL), + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts) + ) + ) + + normalize_counts( + moo, + group_colname = "Group", + label_colname = "Label", + samples_to_rename = c("A1:Alpha 1"), + add_label_to_pca = FALSE, + principal_component_on_x_axis = 2, + principal_component_on_y_axis = 3, + legend_position_for_pca = "bottom", + label_offset_x_ = 4, + label_offset_y_ = 5, + label_font_size = 6, + point_size_for_pca = 7, + color_histogram_by_group = FALSE, + set_min_max_for_x_axis_for_histogram = TRUE, + minimum_for_x_axis_for_histogram = -2, + maximum_for_x_axis_for_histogram = 2, + legend_font_size_for_histogram = 11, + legend_position_for_histogram = "right", + number_of_histogram_legend_columns = 2, + colors_for_plots = c(A = "red", B = "blue", C = "green"), + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expect_equal(pca_args$samples_to_rename, c("A1:Alpha 1")) + expect_equal(pca_args$principal_components, c(2, 3)) + expect_equal(pca_args$legend_position, "bottom") + expect_equal(pca_args$point_size, 7) + expect_null(pca_args$label_colname) + expect_equal(pca_args$label_font_size, 6) + expect_equal(pca_args$label_offset_x_, 4) + expect_equal(pca_args$label_offset_y_, 5) + expect_equal(pca_args$color_values, c(A = "red", B = "blue", C = "green")) + + expect_false(histogram_args$color_by_group) + expect_true(histogram_args$set_min_max_for_x_axis) + expect_equal(histogram_args$minimum_for_x_axis, -2) + expect_equal(histogram_args$maximum_for_x_axis, 2) + expect_equal(histogram_args$legend_font_size, 11) + expect_equal(histogram_args$legend_position, "right") + expect_equal(histogram_args$number_of_legend_columns, 2) + expect_equal(histogram_args$color_values, moo@analyses[["colors"]][["Label"]]) + + pca_args <- NULL + normalize_counts( + moo, + group_colname = "Group", + label_colname = "Label", + add_label_to_pca = TRUE, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + expect_equal(pca_args$label_colname, "Label") +}) + +test_that("normalize_counts handles histogram label combinations", { + pca_args <- NULL + histogram_args <- NULL + group_colors <- c(A = "red", B = "blue", C = "green") + + local_mocked_bindings( + plot_pca = function(...) { + pca_args <<- list(...) + ggplot2::ggplot() + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + ggplot2::ggplot() + }, + print_or_save_plot = function(...) invisible(NULL), + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts) + ) + ) + + combinations <- list( + list( + label_colname = NULL, + color_histogram_by_group = FALSE, + interactive_plots = FALSE + ), + list( + label_colname = NULL, + color_histogram_by_group = FALSE, + interactive_plots = TRUE + ), + list( + label_colname = NULL, + color_histogram_by_group = TRUE, + interactive_plots = FALSE + ), + list( + label_colname = NULL, + color_histogram_by_group = TRUE, + interactive_plots = TRUE + ), + list( + label_colname = "Label", + color_histogram_by_group = FALSE, + interactive_plots = FALSE + ), + list( + label_colname = "Label", + color_histogram_by_group = FALSE, + interactive_plots = TRUE + ), + list( + label_colname = "Label", + color_histogram_by_group = TRUE, + interactive_plots = FALSE + ), + list( + label_colname = "Label", + color_histogram_by_group = TRUE, + interactive_plots = TRUE + ) + ) + + for (combination in combinations) { + pca_args <- NULL + histogram_args <- NULL + normalize_counts( + moo, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + label_colname = combination$label_colname, + color_histogram_by_group = combination$color_histogram_by_group, + interactive_plots = combination$interactive_plots, + colors_for_plots = group_colors, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expected_label_colname <- if (is.null(combination$label_colname)) { + "Sample" + } else { + combination$label_colname + } + expected_histogram_colors <- if ( + isTRUE(combination$color_histogram_by_group) + ) { + group_colors + } else { + moo@analyses[["colors"]][[expected_label_colname]] + } + + expect_equal(pca_args$label_colname, combination$label_colname) + expect_equal(histogram_args$label_colname, expected_label_colname) + expect_equal( + histogram_args$color_by_group, + combination$color_histogram_by_group + ) + expect_equal( + histogram_args$interactive_plots, + combination$interactive_plots + ) + expect_equal(histogram_args$color_values, expected_histogram_colors) + } +}) + +test_that("normalize_counts forwards the default MOSuite plot colors", { + pca_args <- NULL + histogram_args <- NULL + default_colors <- c( + "A" = "#5954d6", + "B" = "#e1562c", + "C" = "#b80058" + ) + + local_mocked_bindings( + plot_pca = function(...) { + pca_args <<- list(...) + ggplot2::ggplot() + }, + plot_histogram = function(...) { + histogram_args <<- list(...) + ggplot2::ggplot() + }, + print_or_save_plot = function(...) invisible(NULL), + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts) + ) + ) + + normalize_counts( + moo, + group_colname = "Group", + label_colname = "Label", + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expect_equal(pca_args$color_values, default_colors) + expect_equal(histogram_args$color_values, default_colors) +}) + +test_that("normalize_counts PCA matches standalone plot_pca on normalized output", { + pca_capture <- capture_saved_pca_plot() + local_mocked_bindings( + print_or_save_plot = pca_capture$print_or_save_plot, + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts) + ) + ) |> + normalize_counts( + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + label_colname = NULL, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE + ) + + expected_pca <- plot_pca( + moo@counts$norm$voom, + sample_metadata = moo@sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + label_colname = NULL, + samples_to_rename = c(""), + principal_components = c(1, 2), + legend_position = "top", + point_size = 5, + label_font_size = 3, + label_offset_y_ = 2, + label_offset_x_ = 2, + log_transform = FALSE, + print_plots = FALSE, + save_plots = FALSE + ) + + expect_s3_class(pca_capture$get(), "ggplot") + expect_pca_coordinates_equal(pca_capture$get(), expected_pca) +}) + +test_that("normalize_counts histogram matches standalone plot_histogram on normalized output", { + histogram_capture <- capture_saved_histogram_plot() + local_mocked_bindings( + print_or_save_plot = histogram_capture$print_or_save_plot, + .package = "MOSuite" + ) + + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "clean" = as.data.frame(nidap_clean_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts) + ) + ) |> + normalize_counts( + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + label_colname = NULL, + plot_corr_matrix_heatmap = FALSE, + print_plots = TRUE, + save_plots = FALSE, + interactive_plots = FALSE + ) + + expected_histogram <- plot_histogram( + moo@counts$norm$voom, + sample_metadata = moo@sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + label_colname = NULL, + color_by_group = TRUE, + x_axis_label = "Normalized Counts", + set_min_max_for_x_axis = FALSE, + minimum_for_x_axis = -1, + maximum_for_x_axis = 1, + legend_position = "top", + legend_font_size = NULL, + number_of_legend_columns = 6, + interactive_plots = FALSE + ) + + ggplot2::labs(caption = "normalized counts") + + expect_s3_class(histogram_capture$get(), "ggplot") + expect_histogram_layers_equal(histogram_capture$get(), expected_histogram) +}) diff --git a/code/MOSuite/tests/testthat/test-plot_heatmap.R b/code/MOSuite/tests/testthat/test-plot_heatmap.R index ba9fb1a..6eb11f2 100644 --- a/code/MOSuite/tests/testthat/test-plot_heatmap.R +++ b/code/MOSuite/tests/testthat/test-plot_heatmap.R @@ -121,6 +121,40 @@ test_that("correlation heatmap works", { ) }) +test_that("correlation heatmap resolves annotation colors by first observed group order", { + counts_dat <- nidap_filtered_counts[, c( + "Gene", + "B1", + "B2", + "B3", + "A1", + "A2", + "A3", + "C1", + "C2", + "C3" + )] + sample_metadata <- as.data.frame(nidap_sample_metadata) + sample_metadata <- sample_metadata[ + match(colnames(counts_dat)[-1], sample_metadata$Sample), + ] + + p <- plot_corr_heatmap( + counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + label_colname = "Label", + group_colname = "Group", + color_values = c("#5954d6", "#e1562c", "#b80058") + ) + + expect_equal( + p@top_annotation@anno_list$Group@color_mapping@colors[c("B", "A", "C")], + c(B = "#5954D6FF", A = "#E1562CFF", C = "#B80058FF") + ) +}) + test_that("plot_corr_heatmap method dispatch works", { moo <- multiOmicDataSet( sample_metadata = as.data.frame(nidap_sample_metadata), @@ -261,3 +295,290 @@ test_that("plot_expr_heatmap works", { expect_equal(p_moo@matrix, p_dat@matrix) }) + +test_that("plot_expr_heatmap uses stored colors for all group_columns from moo@analyses$colors", { + moo <- multiOmicDataSet( + sample_metadata = as.data.frame(nidap_sample_metadata), + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "norm" = list("voom" = as.data.frame(nidap_norm_counts)) + ) + ) + custom_colors <- list( + Group = c(A = "#AA0000", B = "#00AA00", C = "#0000AA"), + Replicate = c("1" = "#111111", "2" = "#222222", "3" = "#333333"), + Batch = c("1" = "#AAAAAA", "2" = "#BBBBBB") + ) + moo@analyses$colors <- custom_colors + + expect_message( + p <- plot_expr_heatmap( + moo, + count_type = "norm", + sub_count_type = "voom", + feature_id_colname = "Gene", + group_columns = c("Group", "Replicate", "Batch") + ), + "total number of genes in heatmap", + fixed = FALSE + ) + + expect_equal( + p@top_annotation@anno_list$Group@color_mapping@colors, + c(A = "#AA0000FF", B = "#00AA00FF", C = "#0000AAFF") + ) + expect_equal( + p@top_annotation@anno_list$Replicate@color_mapping@colors, + c("1" = "#111111FF", "2" = "#222222FF", "3" = "#333333FF") + ) + expect_equal( + p@top_annotation@anno_list$Batch@color_mapping@colors, + c("1" = "#AAAAAAFF", "2" = "#BBBBBBFF") + ) +}) + +test_that("plot_expr_heatmap resolves annotation colors by first observed group order", { + counts_dat <- nidap_norm_counts[, c( + "Gene", + "B1", + "B2", + "B3", + "A1", + "A2", + "A3", + "C1", + "C2", + "C3" + )] + sample_metadata <- as.data.frame(nidap_sample_metadata) + sample_metadata <- sample_metadata[ + match(colnames(counts_dat)[-1], sample_metadata$Sample), + ] + + expect_message( + p <- plot_expr_heatmap( + as.data.frame(counts_dat), + sample_metadata = sample_metadata, + feature_id_colname = "Gene", + samples_to_include = colnames(counts_dat)[-1], + group_columns = "Group", + group_colors = c("#5954d6", "#e1562c", "#b80058") + ), + "total number of genes in heatmap", + fixed = FALSE + ) + + expect_equal( + p@top_annotation@anno_list$Group@color_mapping@colors[c("B", "A", "C")], + c(B = "#5954D6FF", A = "#E1562CFF", C = "#B80058FF") + ) +}) + +test_that("plot_expr_heatmap uses selected gene distance metric", { + counts_dat <- data.frame( + Gene = paste0("g", 1:8), + s1 = c( + -0.6264538, + 0.1836433, + -0.8356286, + 1.5952808, + 0.3295078, + -0.8204684, + 0.4874291, + 0.7383247 + ), + s2 = c( + 0.57578135, + -0.30538839, + 1.51178117, + 0.38984324, + -0.62124058, + -2.21469989, + 1.12493092, + -0.04493361 + ), + s3 = c( + -0.01619026, + 0.94383621, + 0.82122120, + 0.59390132, + 0.91897737, + 0.78213630, + 0.07456498, + -1.98935170 + ), + s4 = c( + 0.61982575, + -0.05612874, + -0.15579551, + -1.47075238, + -0.47815006, + 0.41794156, + 1.35867955, + -0.10278773 + ), + s5 = c( + 0.38767161, + -0.05380504, + -1.37705956, + -0.41499456, + -0.39428995, + -0.05931340, + 1.10002537, + 0.76317575 + ), + check.names = FALSE + ) + sample_metadata <- data.frame( + Sample = paste0("s", 1:5), + Group = c("A", "A", "B", "B", "C") + ) + + common_args <- list( + moo_counts = counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + include_all_genes = TRUE, + filter_top_genes_by_variance = FALSE, + center_and_rescale_expression = FALSE, + cluster_genes = TRUE, + gene_clustering_method = "complete", + cluster_samples = FALSE, + arrange_sample_columns = TRUE, + group_columns = "Group", + print_plots = FALSE, + save_plots = FALSE + ) + + expect_message( + p_euclidean <- do.call( + plot_expr_heatmap, + c(common_args, list(gene_distance_metric = "euclidean")) + ), + "total number of genes in heatmap" + ) + expect_message( + p_correlation <- do.call( + plot_expr_heatmap, + c(common_args, list(gene_distance_metric = "correlation")) + ), + "total number of genes in heatmap" + ) + + expect_equal( + p_euclidean@row_dend_param$obj$order, + c(2, 5, 4, 3, 1, 7, 8, 6) + ) + expect_equal( + p_correlation@row_dend_param$obj$order, + c(2, 5, 6, 3, 4, 1, 7, 8) + ) +}) + +test_that("plot_expr_heatmap uses selected sample clustering method", { + counts_dat <- data.frame( + Gene = paste0("g", 1:8), + s1 = c( + -0.89691455, + 0.18484918, + 1.58784533, + -1.13037567, + -0.08025176, + 0.13242028, + 0.70795473, + -0.23969802 + ), + s2 = c( + 1.9844739, + -0.1387870, + 0.4176508, + 0.9817528, + -0.3926954, + -1.0396690, + 1.7822290, + -2.3110691 + ), + s3 = c( + 0.87860458, + 0.03580672, + 1.01282869, + 0.43226515, + 2.09081921, + -1.19992582, + 1.58963820, + 1.95465164 + ), + s4 = c( + 0.004937777, + -2.451706388, + 0.477237303, + -0.596558169, + 0.792203270, + 0.289636710, + 0.738938604, + 0.318960401 + ), + s5 = c( + 1.0761644, + -0.2841577, + -0.7766753, + -0.5956605, + -1.7259798, + -0.9025845, + -0.5590619, + -0.2465126 + ), + s6 = c( + -0.38358623, + -1.95910318, + -0.84170506, + 1.90354747, + 0.62249393, + 1.99092044, + -0.30548372, + -0.09084424 + ), + check.names = FALSE + ) + sample_metadata <- data.frame( + Sample = paste0("s", 1:6), + Group = c("A", "A", "B", "B", "C", "C") + ) + + common_args <- list( + moo_counts = counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + include_all_genes = TRUE, + filter_top_genes_by_variance = FALSE, + center_and_rescale_expression = FALSE, + cluster_genes = FALSE, + cluster_samples = TRUE, + arrange_sample_columns = FALSE, + smpl_distance_metric = "euclidean", + group_columns = "Group", + print_plots = FALSE, + save_plots = FALSE + ) + + expect_message( + p_complete <- do.call( + plot_expr_heatmap, + c(common_args, list(smpl_clustering_method = "complete")) + ), + "total number of genes in heatmap" + ) + expect_message( + p_single <- do.call( + plot_expr_heatmap, + c(common_args, list(smpl_clustering_method = "single")) + ), + "total number of genes in heatmap" + ) + + expect_equal(p_complete@column_dend_param$obj$order, c(6, 5, 2, 3, 4, 1)) + expect_equal(p_single@column_dend_param$obj$order, c(2, 3, 5, 6, 4, 1)) +}) diff --git a/code/MOSuite/tests/testthat/test-plot_histogram.R b/code/MOSuite/tests/testthat/test-plot_histogram.R index 598289d..924c7a2 100644 --- a/code/MOSuite/tests/testthat/test-plot_histogram.R +++ b/code/MOSuite/tests/testthat/test-plot_histogram.R @@ -79,6 +79,143 @@ sample_meta <- structure( row.names = c("A1", "A2", "A3", "B1", "B2", "B3", "C1", "C2", "C3"), class = "data.frame" ) + +get_histogram_colour_guide_ncol <- function(plot) { + return(plot$guides$guides$colour$params$ncol) +} + +get_plotly_text <- function(plot) { + traces <- plotly::plotly_build(plot)$x$data + return(unlist( + lapply(traces, function(trace) trace$text), + use.names = FALSE + )) +} + +test_that("plot_histogram interactive hover text includes sample and group", { + counts_dat <- log_counts |> + as.data.frame() |> + tibble::rownames_to_column("Gene") + + plot_by_group <- suppressWarnings(plot_histogram( + counts_dat, + sample_metadata = sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + color_by_group = TRUE, + interactive_plots = TRUE + )) + plot_by_sample <- suppressWarnings(plot_histogram( + counts_dat, + sample_metadata = sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + color_by_group = FALSE, + interactive_plots = TRUE + )) + + hover_text_by_group <- get_plotly_text(plot_by_group) + hover_text_by_sample <- get_plotly_text(plot_by_sample) + expect_true(any(grepl("Sample: A1", hover_text_by_group, fixed = TRUE))) + expect_true(any(grepl("Group: A", hover_text_by_group, fixed = TRUE))) + expect_true(any(grepl("Sample: A1", hover_text_by_sample, fixed = TRUE))) + expect_true(any(grepl("Group: A", hover_text_by_sample, fixed = TRUE))) +}) + +test_that("plot_histogram interactive output keeps legend", { + counts_dat <- log_counts |> + as.data.frame() |> + tibble::rownames_to_column("Gene") + + plot <- suppressWarnings(plot_histogram( + counts_dat, + sample_metadata = sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + color_by_group = TRUE, + interactive_plots = TRUE + )) + built_plot <- plotly::plotly_build(plot) + + expect_false(identical(built_plot$x$layout$showlegend, FALSE)) + expect_true(any(vapply( + built_plot$x$data, + function(trace) !is.null(trace$name) && nzchar(trace$name), + logical(1) + ))) +}) + +test_that("plot_histogram wraps long top and bottom sample-name legends", { + counts_dat <- log_counts |> + as.data.frame() |> + tibble::rownames_to_column("Gene") + sample_columns <- setdiff(colnames(counts_dat), "Gene") + long_sample_names <- stats::setNames( + sprintf("SampleName%05d", seq_along(sample_columns)), + sample_columns + ) + colnames(counts_dat) <- ifelse( + colnames(counts_dat) %in% names(long_sample_names), + unname(long_sample_names[colnames(counts_dat)]), + colnames(counts_dat) + ) + sample_metadata <- sample_meta + sample_metadata$Sample <- unname(long_sample_names[as.character( + sample_metadata$Sample + )]) + sample_metadata$Label <- sample_metadata$Sample + + for (legend_position in c("top", "bottom")) { + plot <- plot_histogram( + counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + color_by_group = FALSE, + legend_position = legend_position, + number_of_legend_columns = 6 + ) + + expect_equal(get_histogram_colour_guide_ncol(plot), 3) + } +}) + +test_that("plot_histogram legend columns target the colour guide", { + plot <- plot_histogram( + log_counts |> + as.data.frame() |> + tibble::rownames_to_column("Gene"), + sample_meta, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + color_by_group = FALSE, + legend_position = "top", + number_of_legend_columns = 2 + ) + + expect_equal(get_histogram_colour_guide_ncol(plot), 2) +}) + +test_that("plot_histogram uses line glyphs for density legend keys", { + plot <- plot_histogram( + nidap_filtered_counts, + sample_metadata = nidap_sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + color_by_group = TRUE + ) + + expect_equal( + plot$guides$guides$colour$params$override.aes, + list(linetype = 1, linewidth = 2, shape = NA, fill = NA) + ) + expect_s3_class(plot$theme$legend.key, "element_blank") +}) + test_that("plot_histogram works with rownames", { p <- plot_histogram( log_counts |> as.data.frame() |> tibble::rownames_to_column("Gene"), @@ -515,6 +652,165 @@ test_that("plot_histogram works with rownames", { ) }) +test_that("plot_histogram resolves group colors by first observed group order", { + color_values <- c("#5954d6", "#e1562c", "#b80058") + counts_dat <- nidap_filtered_counts[, c( + "Gene", + "B1", + "B2", + "B3", + "A1", + "A2", + "A3", + "C1", + "C2", + "C3" + )] + plot <- plot_histogram( + counts_dat, + sample_metadata = nidap_sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + color_values = color_values, + color_by_group = TRUE + ) + scales <- ggplot2::ggplot_build(plot)$plot$scales$scales + colour_scale <- scales[[which(vapply( + scales, + function(scale) "colour" %in% scale$aesthetics, + logical(1) + ))[[1]]]] + + expect_equal( + colour_scale$palette.cache, + c(B = "#5954d6", A = "#e1562c", C = "#b80058") + ) +}) + +test_that("plot_histogram resolves group colors by factor level order", { + color_values <- c("#5954d6", "#e1562c", "#b80058") + counts_dat <- nidap_filtered_counts[, c( + "Gene", + "B1", + "B2", + "B3", + "A1", + "A2", + "A3", + "C1", + "C2", + "C3" + )] + sample_metadata <- nidap_sample_metadata + sample_metadata$Group <- factor( + sample_metadata$Group, + levels = c("C", "A", "B") + ) + + plot <- plot_histogram( + counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Group", + color_values = color_values, + color_by_group = TRUE + ) + scales <- ggplot2::ggplot_build(plot)$plot$scales$scales + colour_scale <- scales[[which(vapply( + scales, + function(scale) "colour" %in% scale$aesthetics, + logical(1) + ))[[1]]]] + + expect_equal( + colour_scale$palette.cache, + c(C = "#5954d6", A = "#e1562c", B = "#b80058") + ) +}) + +test_that("plot_histogram resolves sample colors by first observed sample order", { + color_values <- c("#5954d6", "#e1562c", "#b80058", "#00c6f8") + counts_dat <- nidap_filtered_counts[, c("Gene", "B1", "A1", "C1", "A2")] + plot <- plot_histogram( + counts_dat, + sample_metadata = nidap_sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + color_values = color_values, + color_by_group = FALSE + ) + scales <- ggplot2::ggplot_build(plot)$plot$scales$scales + colour_scale <- scales[[which(vapply( + scales, + function(scale) "colour" %in% scale$aesthetics, + logical(1) + ))[[1]]]] + + expect_equal( + colour_scale$palette.cache, + c(B1 = "#5954d6", A1 = "#e1562c", C1 = "#b80058", A2 = "#00c6f8") + ) +}) + +test_that("plot_histogram automatically sets log2 axis breaks when requested", { + counts_dat <- data.frame( + Gene = "gene_a", + S1 = 0, + S2 = 4, + S3 = 16, + check.names = FALSE + ) + sample_metadata <- data.frame( + Sample = c("S1", "S2", "S3"), + Group = c("A", "A", "A"), + check.names = FALSE + ) + + plot <- plot_histogram( + counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + color_by_group = FALSE, + use_log2_x_axis = TRUE + ) + x_scale <- plot$scales$get_scales("x") + axis_breaks <- x_scale$breaks(c(0.5, 64.5)) + + expect_equal(plot$data$count, c(0.5, 4.5, 16.5)) + expect_true(all(c(0.5, 4.5, 16.5, 64.5) %in% axis_breaks)) + expect_equal(x_scale$labels(c(0.5, 4.5, 16.5)), c("0", "4", "16")) +}) + +test_that("plot_histogram automatic log2 axis starts at zero", { + counts_dat <- data.frame( + Gene = "gene_a", + S1 = 4, + S2 = 16, + check.names = FALSE + ) + sample_metadata <- data.frame( + Sample = c("S1", "S2"), + Group = c("A", "A"), + check.names = FALSE + ) + + plot <- plot_histogram( + counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + color_by_group = FALSE, + use_log2_x_axis = TRUE + ) + x_scale <- plot$scales$get_scales("x") + + expect_equal(2^x_scale$limits[1], 0.5) + expect_equal(x_scale$labels(2^x_scale$limits[1]), "0") +}) + test_that("plot_histogram works with tibbles", { p <- plot_histogram( nidap_filtered_counts, diff --git a/code/MOSuite/tests/testthat/test-plot_pca.R b/code/MOSuite/tests/testthat/test-plot_pca.R index db003f3..4f5af90 100644 --- a/code/MOSuite/tests/testthat/test-plot_pca.R +++ b/code/MOSuite/tests/testthat/test-plot_pca.R @@ -178,8 +178,7 @@ test_that("plot_pca layers are expected", { "#878500" ), legend_position = "top", - point_size = 1, - add_label = TRUE, + point_size = 5, label_font_size = 3, label_offset_y_ = 2, label_offset_x_ = 2 @@ -189,6 +188,231 @@ test_that("plot_pca layers are expected", { expect_s3_class(p$layers[[1]]$geom, "GeomPoint") }) +normalize_color_values <- function(colors) { + vapply( + colors, + function(color) { + if (grepl("^rgba\\(", color)) { + color_parts <- strsplit(gsub("^rgba\\(|\\)$", "", color), ",")[[1]] + color_parts <- as.numeric(color_parts[seq_len(3)]) + grDevices::rgb( + color_parts[1], + color_parts[2], + color_parts[3], + maxColorValue = 255 + ) + } else { + rgb_value <- grDevices::col2rgb(color) + grDevices::rgb( + rgb_value[1, 1], + rgb_value[2, 1], + rgb_value[3, 1], + maxColorValue = 255 + ) + } + }, + character(1), + USE.NAMES = FALSE + ) +} + +get_colour_scale <- function(plot) { + scales <- ggplot2::ggplot_build(plot)$plot$scales$scales + scales[[which(vapply( + scales, + function(scale) "colour" %in% scale$aesthetics, + logical(1) + ))[[1]]]] +} + +get_colour_guide_ncol <- function(plot) { + plot$guides$guides$colour$params$ncol +} + +has_text_repel_layer <- function(plot) { + any(vapply( + plot$layers, + function(layer) inherits(layer$geom, "GeomTextRepel"), + logical(1) + )) +} + +get_plotly_text <- function(plot) { + traces <- plotly::plotly_build(plot)$x$data + unlist( + lapply(traces, function(trace) trace$text), + use.names = FALSE + ) +} + +test_that("2D PCA wraps long top and bottom sample-name legends", { + sample_columns <- setdiff(colnames(nidap_filtered_counts), "Gene") + long_sample_names <- stats::setNames( + sprintf("SampleName%05d", seq_along(sample_columns)), + sample_columns + ) + counts_dat <- nidap_filtered_counts + colnames(counts_dat) <- ifelse( + colnames(counts_dat) %in% names(long_sample_names), + unname(long_sample_names[colnames(counts_dat)]), + colnames(counts_dat) + ) + sample_metadata <- nidap_sample_metadata + sample_metadata$Sample <- unname(long_sample_names[as.character( + sample_metadata$Sample + )]) + sample_metadata$Label <- sample_metadata$Sample + + for (legend_position in c("top", "bottom")) { + pca_2d <- plot_pca_2d( + counts_dat, + sample_metadata = sample_metadata, + sample_id_colname = "Sample", + feature_id_colname = "Gene", + group_colname = "Sample", + label_colname = NULL, + legend_position = legend_position, + print_plots = FALSE, + save_plots = FALSE + ) + + expect_equal(get_colour_guide_ncol(pca_2d), 3) + } +}) + +test_that("2D and 3D PCA resolve unnamed colors by first observed group order", { + color_values <- c("#5954d6", "#e1562c", "#b80058") + expected_colors <- c(B = "#5954d6", A = "#e1562c", C = "#b80058") + counts_dat <- nidap_filtered_counts[, c( + "Gene", + "B1", + "B2", + "B3", + "A1", + "A2", + "A3", + "C1", + "C2", + "C3" + )] + + pca_2d <- plot_pca_2d( + counts_dat, + sample_metadata = nidap_sample_metadata, + feature_id_colname = "Gene", + color_values = color_values, + label_colname = NULL, + print_plots = FALSE, + save_plots = FALSE + ) + pca_2d_colors <- get_colour_scale(pca_2d)$palette.cache[names( + expected_colors + )] + + pca_3d <- plot_pca_3d( + counts_dat, + sample_metadata = nidap_sample_metadata, + feature_id_colname = "Gene", + color_values = color_values, + print_plots = FALSE, + save_plots = FALSE + ) + pca_3d_traces <- plotly::plotly_build(pca_3d)$x$data + pca_3d_colors <- stats::setNames( + normalize_color_values(vapply( + pca_3d_traces, + function(trace) trace$marker$color, + character(1) + )), + vapply(pca_3d_traces, function(trace) trace$name, character(1)) + )[names(expected_colors)] + + expected_colors <- stats::setNames( + normalize_color_values(expected_colors), + names(expected_colors) + ) + + expect_equal(normalize_color_values(pca_2d_colors), unname(expected_colors)) + expect_equal(pca_3d_colors, expected_colors) +}) + +test_that("2D and 3D PCA resolve unnamed colors by factor level order", { + color_values <- c("#5954d6", "#e1562c", "#b80058") + expected_colors <- c(C = "#5954d6", A = "#e1562c", B = "#b80058") + counts_dat <- nidap_filtered_counts[, c( + "Gene", + "B1", + "B2", + "B3", + "A1", + "A2", + "A3", + "C1", + "C2", + "C3" + )] + sample_metadata <- nidap_sample_metadata + sample_metadata$Group <- factor( + sample_metadata$Group, + levels = c("C", "A", "B") + ) + + pca_2d <- plot_pca_2d( + counts_dat, + sample_metadata = sample_metadata, + feature_id_colname = "Gene", + color_values = color_values, + label_colname = NULL, + print_plots = FALSE, + save_plots = FALSE + ) + pca_2d_colors <- get_colour_scale(pca_2d)$palette.cache[names( + expected_colors + )] + + pca_3d <- plot_pca_3d( + counts_dat, + sample_metadata = sample_metadata, + feature_id_colname = "Gene", + color_values = color_values, + print_plots = FALSE, + save_plots = FALSE + ) + pca_3d_traces <- plotly::plotly_build(pca_3d)$x$data + pca_3d_colors <- stats::setNames( + normalize_color_values(vapply( + pca_3d_traces, + function(trace) trace$marker$color, + character(1) + )), + vapply(pca_3d_traces, function(trace) trace$name, character(1)) + )[names(expected_colors)] + + expected_colors <- stats::setNames( + normalize_color_values(expected_colors), + names(expected_colors) + ) + + expect_equal(normalize_color_values(pca_2d_colors), unname(expected_colors)) + expect_equal(pca_3d_colors, expected_colors) +}) + +test_that("2D PCA preserves named color mappings", { + color_values <- c(C = "#5954d6", A = "#e1562c", B = "#b80058") + + pca_2d <- plot_pca_2d( + nidap_filtered_counts, + sample_metadata = nidap_sample_metadata, + feature_id_colname = "Gene", + color_values = color_values, + label_colname = NULL, + print_plots = FALSE, + save_plots = FALSE + ) + + expect_equal(get_colour_scale(pca_2d)$palette.cache, color_values) +}) + test_that("2D & 3D PCA method dispatch works", { moo <- multiOmicDataSet( @@ -327,7 +551,7 @@ test_that("plot_pca_2d works with and without labels", { moo, count_type = "filt", principal_components = c(1, 2), - add_label = TRUE, + label_colname = "Label", save_plots = FALSE, print_plots = FALSE ) @@ -337,11 +561,226 @@ test_that("plot_pca_2d works with and without labels", { moo, count_type = "filt", principal_components = c(1, 2), - add_label = FALSE, + label_colname = NULL, save_plots = FALSE, print_plots = FALSE ) - # With labels should have more layers (geom_text_repel) - expect_gt(length(p_with_labels$layers), length(p_without_labels$layers)) + expect_true(has_text_repel_layer(p_with_labels)) + expect_false(has_text_repel_layer(p_without_labels)) +}) + +test_that("plot_pca_2d interactive hover text includes label column when provided", { + sample_metadata <- as.data.frame(nidap_sample_metadata) + sample_metadata$PlotLabel <- paste0("plot-label-", sample_metadata$Sample) + moo <- multiOmicDataSet( + sample_metadata = sample_metadata, + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts) + ) + ) + + p_with_labels <- suppressWarnings(plot_pca_2d( + moo, + count_type = "filt", + principal_components = c(1, 2), + group_colname = "Group", + label_colname = "PlotLabel", + interactive_plots = TRUE, + save_plots = FALSE, + print_plots = FALSE + )) + p_without_labels <- suppressWarnings(plot_pca_2d( + moo, + count_type = "filt", + principal_components = c(1, 2), + group_colname = "Group", + label_colname = NULL, + interactive_plots = TRUE, + save_plots = FALSE, + print_plots = FALSE + )) + + hover_text_with_labels <- get_plotly_text(p_with_labels) + hover_text_without_labels <- get_plotly_text(p_without_labels) + expect_true(any(grepl("Group: A", hover_text_with_labels, fixed = TRUE))) + expect_true(any(grepl( + "PlotLabel: plot-label-A1", + hover_text_with_labels, + fixed = TRUE + ))) + expect_false(any(grepl("Sample: A1", hover_text_with_labels, fixed = TRUE))) + expect_true(any(grepl("Sample: A1", hover_text_without_labels, fixed = TRUE))) + expect_true(any(grepl("Group: A", hover_text_without_labels, fixed = TRUE))) + expect_false(any(grepl( + "PlotLabel:", + hover_text_without_labels, + fixed = TRUE + ))) +}) + +test_that("plot_pca_3d hover text includes label column when provided", { + sample_metadata <- as.data.frame(nidap_sample_metadata) + sample_metadata$PlotLabel <- paste0("plot-label-", sample_metadata$Sample) + moo <- multiOmicDataSet( + sample_metadata = sample_metadata, + anno_dat = data.frame(), + counts_lst = list( + "raw" = as.data.frame(nidap_raw_counts), + "filt" = as.data.frame(nidap_filtered_counts) + ) + ) + + fig_with_labels <- plot_pca_3d( + moo, + count_type = "filt", + principal_components = c(1, 2, 3), + group_colname = "Group", + label_colname = "PlotLabel", + save_plots = FALSE, + print_plots = FALSE + ) + fig_without_labels <- plot_pca_3d( + moo, + count_type = "filt", + principal_components = c(1, 2, 3), + group_colname = "Group", + label_colname = NULL, + save_plots = FALSE, + print_plots = FALSE + ) + + hover_text_with_labels <- get_plotly_text(fig_with_labels) + hover_text_without_labels <- get_plotly_text(fig_without_labels) + expect_true(any(grepl("Group: A", hover_text_with_labels, fixed = TRUE))) + expect_true(any(grepl( + "PlotLabel: plot-label-A1", + hover_text_with_labels, + fixed = TRUE + ))) + expect_false(any(grepl("Sample: A1", hover_text_with_labels, fixed = TRUE))) + expect_true(any(grepl("Sample: A1", hover_text_without_labels, fixed = TRUE))) + expect_true(any(grepl("Group: A", hover_text_without_labels, fixed = TRUE))) + expect_false(any(grepl( + "PlotLabel:", + hover_text_without_labels, + fixed = TRUE + ))) +}) + +test_that("plot_pca_2d log_transform defaults to original natural-log transform", { + counts_log <- nidap_filtered_counts |> + dplyr::mutate(dplyr::across( + tidyselect::all_of(nidap_sample_metadata$Sample), + ~ log(.x + 0.5) + )) + + p_from_option <- plot_pca_2d( + nidap_filtered_counts, + sample_metadata = nidap_sample_metadata, + feature_id_colname = "Gene", + label_colname = NULL, + log_transform = TRUE, + log_transform_pseudocount = 0.5, + print_plots = FALSE, + save_plots = FALSE + ) + p_from_manual_transform <- plot_pca_2d( + counts_log, + sample_metadata = nidap_sample_metadata, + feature_id_colname = "Gene", + label_colname = NULL, + print_plots = FALSE, + save_plots = FALSE + ) + + option_points <- ggplot2::ggplot_build(p_from_option)$data[[1]][, c("x", "y")] + manual_points <- ggplot2::ggplot_build(p_from_manual_transform)$data[[1]][, c( + "x", + "y" + )] + expect_equal(option_points, manual_points, tolerance = 1e-8) +}) + +test_that("plot_pca_3d log_transform defaults to original natural-log transform", { + counts_log <- nidap_filtered_counts |> + dplyr::mutate(dplyr::across( + tidyselect::all_of(nidap_sample_metadata$Sample), + ~ log(.x + 0.5) + )) + + fig_from_option <- plot_pca_3d( + nidap_filtered_counts, + sample_metadata = nidap_sample_metadata, + feature_id_colname = "Gene", + log_transform = TRUE, + log_transform_pseudocount = 0.5, + print_plots = FALSE, + save_plots = FALSE + ) + fig_from_manual_transform <- plot_pca_3d( + counts_log, + sample_metadata = nidap_sample_metadata, + feature_id_colname = "Gene", + print_plots = FALSE, + save_plots = FALSE + ) + + option_traces <- plotly::plotly_build(fig_from_option)$x$data + manual_traces <- plotly::plotly_build(fig_from_manual_transform)$x$data + expect_equal(length(option_traces), length(manual_traces)) + for (trace_index in seq_along(option_traces)) { + expect_equal( + option_traces[[trace_index]]$x, + manual_traces[[trace_index]]$x, + tolerance = 1e-8 + ) + expect_equal( + option_traces[[trace_index]]$y, + manual_traces[[trace_index]]$y, + tolerance = 1e-8 + ) + expect_equal( + option_traces[[trace_index]]$z, + manual_traces[[trace_index]]$z, + tolerance = 1e-8 + ) + } +}) + +test_that("plot_pca_2d log_transform supports log2 base", { + counts_log <- nidap_filtered_counts |> + dplyr::mutate(dplyr::across( + tidyselect::all_of(nidap_sample_metadata$Sample), + ~ log2(.x + 0.5) + )) + + p_from_option <- plot_pca_2d( + nidap_filtered_counts, + sample_metadata = nidap_sample_metadata, + feature_id_colname = "Gene", + label_colname = NULL, + log_transform = TRUE, + log_transform_pseudocount = 0.5, + log_transform_base = 2, + print_plots = FALSE, + save_plots = FALSE + ) + p_from_manual_transform <- plot_pca_2d( + counts_log, + sample_metadata = nidap_sample_metadata, + feature_id_colname = "Gene", + label_colname = NULL, + print_plots = FALSE, + save_plots = FALSE + ) + + option_points <- ggplot2::ggplot_build(p_from_option)$data[[1]][, c("x", "y")] + manual_points <- ggplot2::ggplot_build(p_from_manual_transform)$data[[1]][, c( + "x", + "y" + )] + expect_equal(option_points, manual_points, tolerance = 1e-8) }) diff --git a/code/MOSuite/tests/testthat/test-plot_read_depth.R b/code/MOSuite/tests/testthat/test-plot_read_depth.R index df2f4e1..d7a5ae5 100644 --- a/code/MOSuite/tests/testthat/test-plot_read_depth.R +++ b/code/MOSuite/tests/testthat/test-plot_read_depth.R @@ -28,3 +28,63 @@ test_that("plot_read_depth accepts extra args via moo dispatch without error", { ) ) }) + +test_that("plot_read_depth can color samples by group", { + moo <- multiOmicDataSet( + sample_metadata = nidap_sample_metadata, + anno_dat = data.frame(), + counts_lst = list("raw" = nidap_raw_counts) + ) + plot <- plot_read_depth( + moo, + count_type = "raw", + sample_id_colname = "Sample", + group_colname = "Group", + color_values = c("A" = "blue", "B" = "green", "C" = "orange") + ) + + built <- ggplot2::ggplot_build(plot) + expect_equal( + unique(built$data[[1]]$fill), + c("blue", "green", "orange") + ) +}) + +test_that("plot_read_depth keeps single-color bars when group_colname is blank", { + moo <- multiOmicDataSet( + sample_metadata = nidap_sample_metadata, + anno_dat = data.frame(), + counts_lst = list("raw" = nidap_raw_counts) + ) + plot <- plot_read_depth( + moo, + count_type = "raw", + sample_id_colname = "Sample", + group_colname = "", + color_values = c("A" = "blue", "B" = "green", "C" = "orange") + ) + + built <- ggplot2::ggplot_build(plot) + expect_equal(unique(built$data[[1]]$fill), "blue") +}) + +test_that("plot_read_depth extends undersupplied group colors", { + moo <- multiOmicDataSet( + sample_metadata = nidap_sample_metadata, + anno_dat = data.frame(), + counts_lst = list("raw" = nidap_raw_counts) + ) + plot <- plot_read_depth( + moo, + count_type = "raw", + sample_id_colname = "Sample", + group_colname = "Group", + color_values = c("blue") + ) + + built <- ggplot2::ggplot_build(plot) + expect_equal( + unique(built$data[[1]]$fill), + c("blue", "#e1562c", "#b80058") + ) +}) diff --git a/code/MOSuite/tests/testthat/test-plot_volcano_enhanced.R b/code/MOSuite/tests/testthat/test-plot_volcano_enhanced.R index a115797..c2342c9 100644 --- a/code/MOSuite/tests/testthat/test-plot_volcano_enhanced.R +++ b/code/MOSuite/tests/testthat/test-plot_volcano_enhanced.R @@ -10,10 +10,12 @@ test_that("plot_volcano_enhanced works on nidap dataset", { }) test_that("plot_volcano_enhanced returns a data frame", { - result <- plot_volcano_enhanced( - nidap_deg_analysis, - save_plots = FALSE, - print_plots = FALSE + expect_no_error( + result <- plot_volcano_enhanced( + nidap_deg_analysis, + save_plots = FALSE, + print_plots = FALSE + ) ) expect_s3_class(result, "data.frame") @@ -22,11 +24,13 @@ test_that("plot_volcano_enhanced returns a data frame", { }) test_that("plot_volcano_enhanced respects num_features_to_label", { - result <- plot_volcano_enhanced( - nidap_deg_analysis, - num_features_to_label = 10, - save_plots = FALSE, - print_plots = FALSE + expect_no_error( + result <- plot_volcano_enhanced( + nidap_deg_analysis, + num_features_to_label = 10, + save_plots = FALSE, + print_plots = FALSE + ) ) expect_s3_class(result, "data.frame") @@ -46,11 +50,12 @@ test_that("plot_volcano_enhanced works with multiOmicDataSet", { ) ) - # Test that it returns a data frame - result <- plot_volcano_enhanced( - moo, - save_plots = FALSE, - print_plots = FALSE + expect_no_error( + result <- plot_volcano_enhanced( + moo, + save_plots = FALSE, + print_plots = FALSE + ) ) expect_s3_class(result, "data.frame") diff --git a/code/MOSuite/tests/testthat/test-plots.R b/code/MOSuite/tests/testthat/test-plots.R index bb965f3..b3a7420 100644 --- a/code/MOSuite/tests/testthat/test-plots.R +++ b/code/MOSuite/tests/testthat/test-plots.R @@ -1,7 +1,7 @@ set.seed(20250225) corr_heatmap_fixture <- function() { - plot_corr_heatmap( + return(plot_corr_heatmap( nidap_filtered_counts |> as.data.frame(), sample_metadata = as.data.frame(nidap_sample_metadata), @@ -23,7 +23,7 @@ corr_heatmap_fixture <- function() { "#FFA500", "#878500" ) - ) + )) } test_that("print_or_save_plot saves ComplexHeatmap to disk without error", { @@ -77,13 +77,14 @@ test_that("print_or_save_plot prints ComplexHeatmap with caption without error", test_that("save_or_print_plot works for ComplexHeatmap", { p <- corr_heatmap_fixture() skip_on_ci() + tmp <- withr::local_tempdir() expect_snapshot_file( print_or_save_plot( p, filename = "heatmap.png", print_plots = FALSE, save_plots = TRUE, - plots_dir = "." + plots_dir = tmp ), "heatmap.png" ) @@ -91,13 +92,19 @@ test_that("save_or_print_plot works for ComplexHeatmap", { test_that("save_or_print_plot works for ggplot", { p <- plot_read_depth(nidap_clean_raw_counts) skip_on_ci() + tmp <- withr::local_tempdir() expect_snapshot_file( print_or_save_plot( p, filename = "read_depth.png", print_plots = FALSE, save_plots = TRUE, - plots_dir = "." + plots_dir = tmp, + device = grDevices::png, + width = 7, + height = 7, + units = "in", + dpi = 300 ), "read_depth.png" ) diff --git a/code/MOSuite/tests/testthat/test-render_report.R b/code/MOSuite/tests/testthat/test-render_report.R new file mode 100644 index 0000000..afdbc99 --- /dev/null +++ b/code/MOSuite/tests/testthat/test-render_report.R @@ -0,0 +1,37 @@ +test_that("render_report runs in a temporary directory", { + skip_if_not_installed("quarto") + skip_if_not_installed("knitr") + skip_if_not_installed("rmarkdown") + + work_dir <- withr::local_tempdir() + out_dir <- withr::local_tempdir() + withr::local_dir(work_dir) + + expect_no_error( + render_report( + quarto_args = c("--output-dir", out_dir), + execute_params = list( + counts_csv = system.file( + "extdata", + "nidap", + "Raw_Counts.csv.gz", + package = "MOSuite" + ), + samplesheet_csv = system.file( + "extdata", + "nidap", + "Sample_Metadata_Bulk_RNA-seq_Training_Dataset_CCBR.csv.gz", + package = "MOSuite" + ), + group_colname = "Group", + label_colname = "Label", + batch_colname = "Batch", + contrasts = c("B-A", "C-A", "B-C") + ) + ) + ) + + expect_true(file.exists("report.qmd")) + expect_true(file.exists(file.path(out_dir, "report.html"))) + expect_false(file.exists("report.html")) +}) diff --git a/code/MOSuite/vignettes/visualization.Rmd b/code/MOSuite/vignettes/visualization.Rmd index c46d6a0..fc6a872 100644 --- a/code/MOSuite/vignettes/visualization.Rmd +++ b/code/MOSuite/vignettes/visualization.Rmd @@ -21,7 +21,7 @@ knitr::opts_chunk$set( library(MOSuite) ``` -## Default plots from each step +## Default plots from main functions Default plots can be printed to the screen and/or saved to the disk. @@ -91,24 +91,17 @@ moo <- moo |> moo <- moo |> filter_diff() ``` -## Customize plots - -TODO - -- show how to use individual plotting functions -- how to customize & override default color palettes -- how to customize ggplot objects +## Specialized plots ### 3D PCA ```{r pca_3D} -plot_pca( - moo@counts$batch, - moo@sample_meta, +plot_pca_3d( + moo, + count_type = "batch", principal_components = c(1, 2, 3), group_colname = "Group", - label_colname = "Label", - color_values = moo@analyses[["colors"]][["Group"]] + label_colname = "Label" ) ``` @@ -118,9 +111,10 @@ plot_pca( heatmap_plot <- plot_expr_heatmap( moo, count_type = "norm", - sub_count_type = "voom" + sub_count_type = "voom", + group_colname = "Group" ) -print(heatmap_plot) +# print(heatmap_plot) ``` ### Volcano @@ -150,3 +144,129 @@ dat_volcano_enhanced <- moo@analyses$diff |> venn_dat <- dat_volcano_summary |> plot_venn_diagram() head(venn_dat) ``` + +## Customizing plots + +```{r print-plots-false, echo = FALSE} +options(moo_print_plots = FALSE) +options(moo_save_plots = FALSE) +``` + +### Plots from main functions + +You can create the plots generated by the main analysis functions directly +so you can customize them to fit your needs. + +See the [visualization reference](https://ccbr.github.io/MOSuite/reference/index.html#visualization) +for a full list of plotting functions. + +#### Examples + +Plot the read depth of the clean counts, using either the `Group` column or the `Batch` column from the metadata for the fill colors: + +```{r plot_read_depth} +plot_read_depth( + moo, + count_type = "clean", + group_colname = "Group" +) +plot_read_depth( + moo, + count_type = "clean", + group_colname = "Batch" +) +``` + + +### Customizing ggplot objects + +Plotting functions that use ggplot2 return ggplot objects. +You can customize them by adding more ggplot layers, just like any other ggplot. + +```{r ggplot2_pca_2D} +plot_pca_2d( + moo, + count_type = "batch", + principal_components = c(1, 2), + group_colname = "Batch", + label_colname = "Label" +) + + ggplot2::labs( + title = "Principle components of batch-corrected counts", + caption = "Normalized counts were batch-corrected using svg::ComBat()" + ) +``` + +### Custom colors + +MOSuite comes bundled with a default palette: +```{r display_palette, fig.height=1.5, fig.width=7} +display_palette() +``` + +When creating a multiOmicDataSet object such as with `create_multiOmicDataSet_from_dataframes()`, +default colors are automatically picked from `mosuite_palette` and set in the analyses slot. +You can access the defaults directly: + +```{r colors_slot} +moo@analyses$colors +``` + +The plotting functions access these colors by default, unless overridden +with the `color_values` argument: + +```{r plot_read_depth_custom_colors} +# color palette accessed from moo@analyses$colors[['Group']] +plot_read_depth( + moo, + count_type = "clean", + group_colname = "Group" +) + +# color palette overridden by color_values +plot_read_depth( + moo, + count_type = "clean", + group_colname = "Group", + color_values = c(A = "red", B = "green", C = "blue") +) +``` + +You can change the default colors in the multiOmicDataSet so that all plotting +functions will use your chosen color palette. + +```{r custom_palette} +moo@analyses$colors[["Batch"]] <- c("1" = "#0E7175", "2" = "#C35BCA") +moo@analyses$colors[["Replicate"]] <- c( + "1" = "#89973D", + "2" = "#E8B92F", + "3" = "#A45E41" +) +moo@analyses$colors[["Group"]] <- c(A = "#E69F00", B = "#56B4E9", C = "#009E73") +``` + +View the colors in a multiOmicDataSet with `display_colors()`: +```{r display_colors, fig.height=5, fig.width=8} +display_colors(moo) +``` + +Plotting functions will then use the custom colors set in `moo@analyses$colors`: + +```{r plots_custom_palette} +plot_read_depth( + moo, + count_type = "clean", + group_colname = "Group" +) +plot_pca_2d( + moo, + count_type = "batch", + group_colname = "Batch" +) +plot_expr_heatmap( + moo, + count_type = "norm", + sub_count_type = "voom", + group_colname = "Group" +) +```