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 0000000..ab1004b Binary files /dev/null and b/code/MOSuite/data/mosuite_palette.rda differ diff --git a/code/MOSuite/inst/extdata/galaxy/1_mosuite-templates/filter_counts.json b/code/MOSuite/inst/extdata/galaxy/1_mosuite-templates/filter_counts.json index f2eca99..fbfc9e7 100644 --- a/code/MOSuite/inst/extdata/galaxy/1_mosuite-templates/filter_counts.json +++ b/code/MOSuite/inst/extdata/galaxy/1_mosuite-templates/filter_counts.json @@ -270,11 +270,11 @@ { "key": "color_histogram_by_group", "displayName": "Color Histogram by Group", - "description": "Toggle to FALSE to label histogram by Sample Names. Toggle to TRUE to label histogram by the column you select in the \"Group Column Used to Color Histogram\" parameter (below). Default is FALSE.", + "description": "Toggle to FALSE to label histogram by Sample Names. Toggle to TRUE to label histogram by the column you select in the \"Group Column Used to Color Histogram\" parameter (below). Default is TRUE.", "paramType": "BOOLEAN", "paramGroup": "Histogram", "paramValues": null, - "defaultValue": "FALSE", + "defaultValue": "TRUE", "condition": null, "content": null, "objectPropertyReference": null diff --git a/code/MOSuite/inst/extdata/galaxy/1_mosuite-templates/normalize_counts.json b/code/MOSuite/inst/extdata/galaxy/1_mosuite-templates/normalize_counts.json index d6073e8..a705030 100644 --- a/code/MOSuite/inst/extdata/galaxy/1_mosuite-templates/normalize_counts.json +++ b/code/MOSuite/inst/extdata/galaxy/1_mosuite-templates/normalize_counts.json @@ -251,11 +251,11 @@ { "key": "color_histogram_by_group", "displayName": "Color Histogram by Group", - "description": "Toggle to FALSE to label histogram by Sample Names. Toggle to TRUE to label histogram by the column you select in the \"Group Column Used to Color Histogram\" parameter (below). Default is FALSE.", + "description": "Toggle to FALSE to label histogram by Sample Names. Toggle to TRUE to label histogram by the column you select in the \"Group Column Used to Color Histogram\" parameter (below). Default is TRUE.", "paramType": "BOOLEAN", "paramGroup": "Histogram", "paramValues": null, - "defaultValue": "FALSE", + "defaultValue": "TRUE", "condition": null, "content": null, "objectPropertyReference": null diff --git a/code/MOSuite/inst/extdata/galaxy/2_blueprints/batch_correct_counts.json b/code/MOSuite/inst/extdata/galaxy/2_blueprints/batch_correct_counts.json index 006f336..e8a5773 100644 --- a/code/MOSuite/inst/extdata/galaxy/2_blueprints/batch_correct_counts.json +++ b/code/MOSuite/inst/extdata/galaxy/2_blueprints/batch_correct_counts.json @@ -53,9 +53,10 @@ { "key": "label_colname", "displayName": "Labels Column", - "description": "The column from the sample metadata containing the sample labels as you wish them to appear in\nthe plots produced by this template. This can be the same Sample Names Column. However, you may desire different\nlabels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the\ncolumn with your preferred Labels here. The selected column should contain unique names for each sample. (Default:\n`NULL` -- `sample_id_colname` will be used.)\n", + "description": "The column from the sample metadata containing the sample labels as you wish them to appear in\nheatmap and PCA figures. This can be the same Sample Names Column. However, you may desire different labels to\ndisplay on your figures (e.g. shorter labels are sometimes preferred on plots). In that case, select the column with\nyour 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.\n", "paramGroup": "Basic", "sourceDataset": "sample_metadata", + "defaultValue": "Label", "columnType": "ALL", "isMulti": null } @@ -114,7 +115,7 @@ { "key": "colors_for_plots", "displayName": "Colors for plots", - "description": "Colors for the PCA and histogram will be picked, in order, from this list.\nColors must either be names in `grDevices::colors()` or valid hex codes.\n", + "description": "Optional colors for PCA/histogram/heatmap plots. If `NULL`, colors are taken from\n`moo@analyses$colors[[group_colname]]`.\nColors must either be names in `grDevices::colors()` or valid hex codes.\nUnnamed colors are assigned by factor level order when the grouping column is a factor;\notherwise, they follow the order in which groups first appear in the metadata column. If more groups are present\nthan colors provided,\nsupplied colors are used first and additional colors are generated from the selected palette for the remaining\ngroups; random colors are used only if that palette returns fewer colors than the number of groups.\n", "paramType": "MULTISELECT", "paramGroup": "Visualization", "paramValues": [ diff --git a/code/MOSuite/inst/extdata/galaxy/2_blueprints/filter_counts.json b/code/MOSuite/inst/extdata/galaxy/2_blueprints/filter_counts.json index 58d5f49..8f104ba 100644 --- a/code/MOSuite/inst/extdata/galaxy/2_blueprints/filter_counts.json +++ b/code/MOSuite/inst/extdata/galaxy/2_blueprints/filter_counts.json @@ -43,9 +43,10 @@ { "key": "label_colname", "displayName": "Labels Column", - "description": "The column from the sample metadata containing the sample labels as you wish them to appear in\nthe plots produced by this template. This can be the same Sample Names Column. However, you may desire different\nlabels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the\ncolumn with your preferred Labels here. The selected column should contain unique names for each sample. (Default:\n`NULL` -- `sample_id_colname` will be used.)\n", + "description": "The column from the sample metadata containing the sample labels as you wish them to appear in\nheatmap and PCA figures. This can be the same Sample Names Column. However, you may desire different labels to\ndisplay on your figures (e.g. shorter labels are sometimes preferred on plots). In that case, select the column with\nyour 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.\n", "paramGroup": "Basic", "sourceDataset": "Sample_Metadata", + "defaultValue": "Label", "columnType": "ALL", "isMulti": null } @@ -104,7 +105,7 @@ { "key": "minimum_count_value_to_be_considered_nonzero", "displayName": "Minimum Count Value to be Considered Nonzero", - "description": "Minimum count value to be considered non-zero for a sample\n", + "description": "Minimum value in the selected filtering table required for a\nsample to be considered nonzero. If `use_cpm_counts_to_filter` is `TRUE`, this threshold is applied to CPM values.\nIf `use_cpm_counts_to_filter` is `FALSE`, this threshold is applied directly to the selected `count_type` table.\n", "paramType": "NUMBER", "paramGroup": "Filtering", "paramValues": null, @@ -116,7 +117,7 @@ { "key": "minimum_number_of_samples_with_nonzero_counts_in_total", "displayName": "Minimum Number of Samples with Nonzero Counts in Total", - "description": "Minimum number of samples (total) with non-zero counts\n", + "description": "Minimum number of samples in total that must meet the\n`minimum_count_value_to_be_considered_nonzero` threshold for a feature to be kept.\n", "paramType": "NUMBER", "paramGroup": "Filtering", "paramValues": null, @@ -128,7 +129,7 @@ { "key": "use_group_based_filtering", "displayName": "Use Group-Based Filtering", - "description": "If TRUE, only keeps features (e.g. genes) that have at least a certain number of\nsamples with nonzero CPM counts in at least one group\n", + "description": "If TRUE, only keeps features (e.g. genes) that have at least a certain number of\nsamples passing the threshold in at least one group\n", "paramType": "BOOLEAN", "paramGroup": "Filtering", "paramValues": null, @@ -140,7 +141,7 @@ { "key": "minimum_number_of_samples_with_nonzero_counts_in_a_group", "displayName": "Minimum Number of Samples with Nonzero Counts in a Group", - "description": "Only keeps genes that have at least this number of\nsamples with nonzero CPM counts in at least one group\n", + "description": "Only keeps genes that have at least this number of\nsamples meeting the threshold in at least one group\n", "paramType": "NUMBER", "paramGroup": "Filtering", "paramValues": null, @@ -198,7 +199,7 @@ "paramType": "NUMBER", "paramGroup": "PCA", "paramValues": null, - "defaultValue": 1, + "defaultValue": 5, "condition": null, "content": null, "objectPropertyReference": null @@ -206,7 +207,7 @@ { "key": "add_label_to_pca", "displayName": "Add Labels to PCA", - "description": "label points on the PCA plot\n", + "description": "If `TRUE`, display labels from `label_colname` on PCA points. If `FALSE`, the PCA plot uses\nunlabeled points while heatmap labels still use `label_colname`.\n", "paramType": "BOOLEAN", "paramGroup": "PCA", "paramValues": null, @@ -266,11 +267,11 @@ { "key": "color_histogram_by_group", "displayName": "Color Histogram by Group", - "description": "Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by\nthe column you select in the \"Group Column Used to Color Histogram\" parameter (below). Default is FALSE.\n", + "description": "Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by\nthe column you select in the \"Group Column Used to Color Histogram\" parameter (below). Default is TRUE.\n", "paramType": "BOOLEAN", "paramGroup": "Histogram", "paramValues": null, - "defaultValue": false, + "defaultValue": true, "condition": null, "content": null, "objectPropertyReference": null @@ -314,11 +315,10 @@ { "key": "legend_font_size_for_histogram", "displayName": "Legend Font Size for Histogram", - "description": "legend font size for the histogram plot\n", + "description": "legend font size for the histogram plot.\nIf `NULL`, the size is scaled automatically.\n", "paramType": "NUMBER", "paramGroup": "Histogram", "paramValues": null, - "defaultValue": 10, "condition": null, "content": null, "objectPropertyReference": null @@ -356,7 +356,7 @@ { "key": "colors_for_plots", "displayName": "Colors for Plots", - "description": "Colors for the PCA and histogram will be picked, in order, from this list.\nColors must either be names in `grDevices::colors()` or valid hex codes.\n", + "description": "Optional colors for PCA/histogram/heatmap plots. If `NULL`, colors are taken from\n`moo@analyses$colors[[group_colname]]`.\nColors must either be names in `grDevices::colors()` or valid hex codes.\nUnnamed colors are assigned by factor level order when the grouping column is a factor;\notherwise, they follow the order in which groups first appear in the metadata column. If more groups are present\nthan colors provided,\nsupplied colors are used first and additional colors are generated from the selected palette for the remaining\ngroups; random colors are used only if that palette returns fewer colors than the number of groups.\n", "paramType": "MULTISELECT", "paramGroup": "Visualization", "paramValues": [ diff --git a/code/MOSuite/inst/extdata/galaxy/2_blueprints/normalize_counts.json b/code/MOSuite/inst/extdata/galaxy/2_blueprints/normalize_counts.json index 118f7fe..f0724d5 100644 --- a/code/MOSuite/inst/extdata/galaxy/2_blueprints/normalize_counts.json +++ b/code/MOSuite/inst/extdata/galaxy/2_blueprints/normalize_counts.json @@ -43,9 +43,10 @@ { "key": "label_colname", "displayName": "Labels Column", - "description": "The column from the sample metadata containing the sample labels as you wish them to appear in\nthe plots produced by this template. This can be the same Sample Names Column. However, you may desire different\nlabels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the\ncolumn with your preferred Labels here. The selected column should contain unique names for each sample. (Default:\n`NULL` -- `sample_id_colname` will be used.)\n", + "description": "The column from the sample metadata containing the sample labels as you wish them to appear in\nheatmap and PCA figures. This can be the same Sample Names Column. However, you may desire different labels to\ndisplay on your figures (e.g. shorter labels are sometimes preferred on plots). In that case, select the column with\nyour 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.\n", "paramGroup": "Basic", "sourceDataset": "Sample_Metadata", + "defaultValue": "Label", "columnType": "ALL", "isMulti": null } @@ -145,7 +146,7 @@ { "key": "add_label_to_pca", "displayName": "Add Labels to PCA", - "description": "label points on the PCA plot\n", + "description": "If `TRUE`, display labels from `label_colname` on PCA points. If `FALSE`, the PCA plot uses\nunlabeled points while heatmap labels still use `label_colname`.\n", "paramType": "BOOLEAN", "paramGroup": "PCA", "paramValues": null, @@ -239,7 +240,7 @@ "paramType": "NUMBER", "paramGroup": "PCA", "paramValues": null, - "defaultValue": 8, + "defaultValue": 5, "condition": null, "content": null, "objectPropertyReference": null @@ -247,7 +248,7 @@ { "key": "color_histogram_by_group", "displayName": "Color Histogram by Group", - "description": "Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by\nthe column you select in the \"Group Column Used to Color Histogram\" parameter (below). Default is FALSE.\n", + "description": "Set to FALSE to label histogram by Sample Names, or set to TRUE to label histogram by\nthe column you select in the \"Group Column Used to Color Histogram\" parameter (below). Default is TRUE.\n", "paramType": "BOOLEAN", "paramGroup": "Histogram", "paramValues": null, @@ -295,11 +296,10 @@ { "key": "legend_font_size_for_histogram", "displayName": "Legend Font Size for Histogram", - "description": "legend font size for the histogram plot\n", + "description": "legend font size for the histogram plot.\nIf `NULL`, the size is scaled automatically.\n", "paramType": "NUMBER", "paramGroup": "Histogram", "paramValues": null, - "defaultValue": 10, "condition": null, "content": null, "objectPropertyReference": null @@ -337,7 +337,7 @@ { "key": "colors_for_plots", "displayName": "Colors for Plots", - "description": "Colors for the PCA and histogram will be picked, in order, from this list.\nColors must either be names in `grDevices::colors()` or valid hex codes.\n", + "description": "Optional colors for PCA/histogram/heatmap plots. If `NULL`, colors are taken from\n`moo@analyses$colors[[group_colname]]`.\nColors must either be names in `grDevices::colors()` or valid hex codes.\nUnnamed colors are assigned by factor level order when the grouping column is a factor;\notherwise, they follow the order in which groups first appear in the metadata column. If more groups are present\nthan colors provided,\nsupplied colors are used first and additional colors are generated from the selected palette for the remaining\ngroups; random colors are used only if that palette returns fewer colors than the number of groups.\n", "paramType": "MULTISELECT", "paramGroup": "Visualization", "paramValues": [ diff --git a/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_expr_heatmap.json b/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_expr_heatmap.json index 5d77de0..519a83c 100644 --- a/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_expr_heatmap.json +++ b/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_expr_heatmap.json @@ -399,7 +399,7 @@ { "key": "group_colors", "displayName": "Group Colors", - "description": "Set group annotation colors.\n", + "description": "Set group annotation colors.", "paramType": "MULTISELECT", "paramGroup": "Annotation", "paramValues": [ @@ -416,7 +416,7 @@ "#FFA500", "#878500" ], - "defaultValue": ["#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"], + "defaultValue": null, "condition": null, "content": null, "objectPropertyReference": null diff --git a/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_pca_2d.json b/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_pca_2d.json index 1655813..7a47d2b 100644 --- a/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_pca_2d.json +++ b/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_pca_2d.json @@ -34,7 +34,7 @@ { "key": "label_colname", "displayName": "Plot Labels Column", - "description": "The column from the sample metadata containing the sample labels as you wish them to appear in\nthe plots produced by this template. This can be the same Sample Names Column. However, you may desire different\nlabels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In that case, select the\ncolumn with your preferred Labels here. The selected column should contain unique names for each sample. (Default:\n`NULL` -- `sample_id_colname` will be used.)\n", + "description": "The column from the sample metadata containing the sample labels as you wish them to appear on\nthe PCA plot. If `NULL`, no labels are added to PCA points. This can be the same Sample Names Column. However, you\nmay desire different labels to display on your figure (e.g. shorter labels are sometimes preferred on plots). In\nthat case, select the column with your preferred Labels here. The selected column should contain unique names for\neach sample.\n", "paramGroup": "Basic", "sourceDataset": "Sample_Metadata_Table", "defaultValue": "Label", @@ -60,7 +60,7 @@ { "key": "count_type", "displayName": "Count Type", - "description": "type to assign the values of `counts_dat` to in the `counts` slot\n", + "description": "the type of counts to use when `moo_counts` is a `multiOmicDataSet`; ignored for data frame input.\n", "paramType": "STRING", "paramGroup": "Basic", "paramValues": null, @@ -71,7 +71,7 @@ { "key": "sub_count_type", "displayName": "Sub Count Type", - "description": "used if `count_type` is a list in the counts slot: specify the sub count type within the list.\nMust be a name in `names(moo@counts[[count_type]])`.\n", + "description": "used when `count_type` refers to a list of count matrices; ignored for data frame input.\n", "paramType": "STRING", "paramGroup": "Basic", "paramValues": null, @@ -104,7 +104,7 @@ "paramType": "NUMBER", "paramGroup": "Visualization", "paramValues": null, - "defaultValue": 1, + "defaultValue": 5, "condition": null, "content": null, "objectPropertyReference": null @@ -112,7 +112,7 @@ { "key": "add_label", "displayName": "Add Labels", - "description": "whether to add text labels for the points\n", + "description": "Whether to add text labels for the points on the plot.", "paramType": "BOOLEAN", "paramGroup": "Visualization", "paramValues": null, @@ -124,7 +124,7 @@ { "key": "label_font_size", "displayName": "Label Font Size", - "description": "label font size for the PCA plot\n", + "description": "font size for text labels on the PCA plot.\n", "paramType": "NUMBER", "paramGroup": "Visualization", "paramValues": null, @@ -154,7 +154,7 @@ { "key": "color_values", "displayName": "Color Values", - "description": "vector of colors as hex values or names recognized by R\n", + "description": "vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor\nlevel order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in\nthe metadata column. Defaults to `NULL`; when `NULL`, `mosuite_palette` is used for `data.frame` dispatch and\nstored colors are used for `multiOmicDataSet` dispatch.\n", "paramType": "MULTISELECT", "paramGroup": "Visualization", "paramValues": [ @@ -233,7 +233,6 @@ "gray80", "lightgrey" ], - "defaultValue": ["#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"], "condition": null, "content": null, "objectPropertyReference": null @@ -241,7 +240,7 @@ { "key": "interactive_plots", "displayName": "Interactive Plots", - "description": "set to TRUE to make PCA and Histogram plots interactive with `plotly`, allowing you to hover\nyour mouse over a point or line to view sample information. The similarity heat map will not display if this toggle\nis set to `TRUE`. Default is `FALSE`.\n", + "description": "set to TRUE to make the PCA plot interactive with `plotly`.\n", "paramType": "BOOLEAN", "paramGroup": "Visualization", "paramValues": null, diff --git a/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_pca_3d.json b/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_pca_3d.json index 54b06e8..67b2124 100644 --- a/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_pca_3d.json +++ b/code/MOSuite/inst/extdata/galaxy/2_blueprints/plot_pca_3d.json @@ -94,7 +94,7 @@ { "key": "color_values", "displayName": "Color Values", - "description": "vector of colors as hex values or names recognized by R.\n", + "description": "vector of colors as hex values or names recognized by R. Unnamed colors are assigned by factor\nlevel order when the grouping column is a factor; otherwise, they follow the order in which groups first appear in\nthe metadata column. Defaults to `NULL`; when `NULL`, `mosuite_palette` is used for `data.frame` dispatch and\nstored colors are used for `multiOmicDataSet` dispatch.\n", "paramType": "MULTISELECT", "paramGroup": "Visualization", "paramValues": [ @@ -173,7 +173,6 @@ "gray80", "lightgrey" ], - "defaultValue": ["#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"], "condition": null, "content": null, "objectPropertyReference": null diff --git a/code/MOSuite/inst/extdata/json_args/common/batch_correct_counts.json b/code/MOSuite/inst/extdata/json_args/common/batch_correct_counts.json index c128597..29270a9 100644 --- a/code/MOSuite/inst/extdata/json_args/common/batch_correct_counts.json +++ b/code/MOSuite/inst/extdata/json_args/common/batch_correct_counts.json @@ -9,6 +9,7 @@ "covariates_colnames": "Group", "batch_colname": "Batch", "label_colname": "Label", + "add_label_to_pca": true, "colors_for_plots": null, "print_plots": true, "save_plots": true, diff --git a/code/MOSuite/inst/extdata/json_args/common/filter_counts.json b/code/MOSuite/inst/extdata/json_args/common/filter_counts.json index 0e71be4..82a362a 100644 --- a/code/MOSuite/inst/extdata/json_args/common/filter_counts.json +++ b/code/MOSuite/inst/extdata/json_args/common/filter_counts.json @@ -5,7 +5,7 @@ "feature_id_colname": null, "sample_id_colname": null, "group_colname": "Group", - "label_colname": null, + "label_colname": "Label", "use_cpm_counts_to_filter": true, "minimum_count_value_to_be_considered_nonzero": 8.0, "minimum_number_of_samples_with_nonzero_counts_in_total": 7.0, @@ -14,17 +14,17 @@ "principal_component_on_x_axis": 1.0, "principal_component_on_y_axis": 2.0, "legend_position_for_pca": "top", - "point_size_for_pca": 1.0, + "point_size_for_pca": 5, "add_label_to_pca": true, "label_font_size": 3.0, "label_offset_x_": 2.0, "label_offset_y_": 2.0, "samples_to_rename": null, - "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.0, "maximum_for_x_axis_for_histogram": 1.0, - "legend_font_size_for_histogram": 10.0, + "legend_font_size_for_histogram": null, "legend_position_for_histogram": "top", "number_of_histogram_legend_columns": 6.0, "colors_for_plots": [ diff --git a/code/MOSuite/inst/extdata/json_args/common/normalize_counts.json b/code/MOSuite/inst/extdata/json_args/common/normalize_counts.json index a5acdb5..2f69306 100644 --- a/code/MOSuite/inst/extdata/json_args/common/normalize_counts.json +++ b/code/MOSuite/inst/extdata/json_args/common/normalize_counts.json @@ -7,7 +7,7 @@ "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": "", @@ -18,14 +18,27 @@ "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", - "colors_for_plots": null, + "colors_for_plots": [ + "#5954d6", + "#e1562c", + "#b80058", + "#00c6f8", + "#d163e6", + "#00a76c", + "#ff9287", + "#008cf9", + "#006e00", + "#796880", + "#FFA500", + "#878500" + ], "print_plots": true, "save_plots": true, "interactive_plots": false, diff --git a/code/MOSuite/inst/extdata/json_args/common/plot_pca_2d.json b/code/MOSuite/inst/extdata/json_args/common/plot_pca_2d.json index ab25827..3635e2c 100644 --- a/code/MOSuite/inst/extdata/json_args/common/plot_pca_2d.json +++ b/code/MOSuite/inst/extdata/json_args/common/plot_pca_2d.json @@ -10,8 +10,7 @@ 1, 2 ], - "point_size": 1, - "add_label": true, + "point_size": 5, "label_font_size": 3, "legend_position": "top", "color_values": [ diff --git a/code/MOSuite/inst/extdata/json_args/defaults/batch_correct_counts.json b/code/MOSuite/inst/extdata/json_args/defaults/batch_correct_counts.json index fe8d42e..3c69dd5 100644 --- a/code/MOSuite/inst/extdata/json_args/defaults/batch_correct_counts.json +++ b/code/MOSuite/inst/extdata/json_args/defaults/batch_correct_counts.json @@ -8,9 +8,27 @@ "samples_to_include": null, "covariates_colnames": "Group", "batch_colname": "Batch", - "label_colname": null, + "label_colname": "Label", + "samples_to_rename": "", + "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": true, "save_plots": true, + "interactive_plots": false, "plots_subdir": "batch" } diff --git a/code/MOSuite/inst/extdata/json_args/defaults/clean_raw_counts.json b/code/MOSuite/inst/extdata/json_args/defaults/clean_raw_counts.json index 43c5568..ba6dada 100644 --- a/code/MOSuite/inst/extdata/json_args/defaults/clean_raw_counts.json +++ b/code/MOSuite/inst/extdata/json_args/defaults/clean_raw_counts.json @@ -5,6 +5,8 @@ "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, diff --git a/code/MOSuite/inst/extdata/json_args/defaults/filter_counts.json b/code/MOSuite/inst/extdata/json_args/defaults/filter_counts.json index 1e6feff..bf19a15 100644 --- a/code/MOSuite/inst/extdata/json_args/defaults/filter_counts.json +++ b/code/MOSuite/inst/extdata/json_args/defaults/filter_counts.json @@ -5,7 +5,7 @@ "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, @@ -15,18 +15,18 @@ "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": "", - "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, diff --git a/code/MOSuite/inst/extdata/json_args/defaults/normalize_counts.json b/code/MOSuite/inst/extdata/json_args/defaults/normalize_counts.json index 50c0e32..ade2bb9 100644 --- a/code/MOSuite/inst/extdata/json_args/defaults/normalize_counts.json +++ b/code/MOSuite/inst/extdata/json_args/defaults/normalize_counts.json @@ -7,7 +7,7 @@ "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": "", @@ -18,12 +18,12 @@ "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, diff --git a/code/MOSuite/inst/extdata/json_args/defaults/plot_expr_heatmap.json b/code/MOSuite/inst/extdata/json_args/defaults/plot_expr_heatmap.json index c421963..e47249f 100644 --- a/code/MOSuite/inst/extdata/json_args/defaults/plot_expr_heatmap.json +++ b/code/MOSuite/inst/extdata/json_args/defaults/plot_expr_heatmap.json @@ -9,7 +9,7 @@ "group_colname": "Group", "label_colname": null, "samples_to_include": null, - "color_values": ["#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, @@ -34,7 +34,6 @@ "group_columns": ["Group", "Replicate", "Batch"], "assign_group_colors": false, "assign_color_to_sample_groups": null, - "group_colors": ["#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, diff --git a/code/MOSuite/inst/extdata/json_args/defaults/plot_pca_2d.json b/code/MOSuite/inst/extdata/json_args/defaults/plot_pca_2d.json index edada7f..41f31b4 100644 --- a/code/MOSuite/inst/extdata/json_args/defaults/plot_pca_2d.json +++ b/code/MOSuite/inst/extdata/json_args/defaults/plot_pca_2d.json @@ -9,14 +9,17 @@ "group_colname": "Group", "label_colname": "Label", "samples_to_rename": null, - "color_values": ["#5954d6", "#e1562c", "#b80058", "#00c6f8", "#d163e6", "#00a76c", "#ff9287", "#008cf9", "#006e00", "#796880", "#FFA500", "#878500"], + "color_values": null, "principal_components": [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", diff --git a/code/MOSuite/inst/extdata/json_args/defaults/plot_pca_3d.json b/code/MOSuite/inst/extdata/json_args/defaults/plot_pca_3d.json index d8e342b..1d0f5b8 100644 --- a/code/MOSuite/inst/extdata/json_args/defaults/plot_pca_3d.json +++ b/code/MOSuite/inst/extdata/json_args/defaults/plot_pca_3d.json @@ -12,7 +12,10 @@ "principal_components": [1, 2, 3], "point_size": 8, "label_font_size": 24, - "color_values": ["#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": true, diff --git a/code/MOSuite/inst/quarto/report.qmd b/code/MOSuite/inst/quarto/report.qmd new file mode 100644 index 0000000..d5090ee --- /dev/null +++ b/code/MOSuite/inst/quarto/report.qmd @@ -0,0 +1,165 @@ +--- +title: "MOSuite analysis report" +date: today +format: html +params: + counts_csv: 'inst/extdata/nidap/Raw_Counts.csv.gz' + samplesheet_csv: 'inst/extdata/nidap/Sample_Metadata_Bulk_RNA-seq_Training_Dataset_CCBR.csv.gz' + group_colname: 'Group' + batch_colname: 'Batch' + label_colname: 'Label' + contrasts: + - B-A + - C-A + - B-C + print_plots: true +engine: knitr +--- + +```{r deps} +library(MOSuite) +library(dplyr) +library(knitr) +options(moo_print_plots = params$print_plots) +``` + +## Load data + +```{r initialize} +# create multi-omic object +counts_csv <- params$counts_csv +if (is.null(counts_csv) || !nzchar(counts_csv) || !file.exists(counts_csv)) { + counts_csv <- system.file( + "extdata", + "nidap", + "Raw_Counts.csv.gz", + package = "MOSuite" + ) +} + +samplesheet_csv <- params$samplesheet_csv +if ( + is.null(samplesheet_csv) || + !nzchar(samplesheet_csv) || + !file.exists(samplesheet_csv) +) { + samplesheet_csv <- system.file( + "extdata", + "nidap", + "Sample_Metadata_Bulk_RNA-seq_Training_Dataset_CCBR.csv.gz", + package = "MOSuite" + ) +} + +moo <- create_multiOmicDataSet_from_files( + sample_meta_filepath = samplesheet_csv, + feature_counts_filepath = counts_csv +) + +group_colname <- params$group_colname +batch_colname <- params$batch_colname +label_colname <- params$label_colname +contrasts_vctr <- params$contrasts +knitr::kable( + data.frame( + Parameter = names(params), + Value = sapply(params, paste, collapse = ", ") + ), + caption = "Parameter values" +) + +knitr::kable( + readr::read_csv(samplesheet_csv, n_max = 10), + caption = "Sample sheet (first 10 rows)" +) + +knitr::kable( + readr::read_csv(counts_csv, n_max = 10), + caption = "Counts data (first 10 rows)" +) +``` + +## Processing + +```{r analyze} +moo <- moo |> + 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 0000000..92664de Binary files /dev/null and b/code/MOSuite/tests/testthat/_snaps/plots/heatmap.png differ diff --git a/code/MOSuite/tests/testthat/_snaps/plots/read_depth.png b/code/MOSuite/tests/testthat/_snaps/plots/read_depth.png new file mode 100644 index 0000000..dd46a96 Binary files /dev/null and b/code/MOSuite/tests/testthat/_snaps/plots/read_depth.png differ diff --git a/code/MOSuite/tests/testthat/helper-functions.R b/code/MOSuite/tests/testthat/helper-functions.R index cb655a1..b3e27ec 100644 --- a/code/MOSuite/tests/testthat/helper-functions.R +++ b/code/MOSuite/tests/testthat/helper-functions.R @@ -57,3 +57,57 @@ test_with_dir <- function(desc, ...) { ) return(invisible()) } + +pca_point_coordinates <- function(plot) { + built_plot <- ggplot2::ggplot_build(plot) + return(built_plot$data[[1]][, c("x", "y")]) +} + +capture_saved_pca_plot <- function() { + pca_plot <- NULL + print_or_save_plot <- function(plot, filename, ...) { + if (basename(filename) == "pca.png") { + pca_plot <<- plot + } + return(invisible(NULL)) + } + return(list( + get = function() pca_plot, + print_or_save_plot = print_or_save_plot + )) +} + +expect_pca_coordinates_equal <- function(actual_plot, expected_plot) { + expect_equal( + pca_point_coordinates(actual_plot), + pca_point_coordinates(expected_plot), + tolerance = 1e-8 + ) +} + +histogram_layer_data <- function(plot) { + built_plot <- ggplot2::ggplot_build(plot) + return(built_plot$data) +} + +capture_saved_histogram_plot <- function() { + histogram_plot <- NULL + print_or_save_plot <- function(plot, filename, ...) { + if (basename(filename) == "histogram.png") { + histogram_plot <<- plot + } + return(invisible(NULL)) + } + return(list( + get = function() histogram_plot, + print_or_save_plot = print_or_save_plot + )) +} + +expect_histogram_layers_equal <- function(actual_plot, expected_plot) { + expect_equal( + histogram_layer_data(actual_plot), + histogram_layer_data(expected_plot), + tolerance = 1e-8 + ) +} diff --git a/code/MOSuite/tests/testthat/test-batch-correction.R b/code/MOSuite/tests/testthat/test-batch-correction.R index 850b004..f5565ce 100644 --- a/code/MOSuite/tests/testthat/test-batch-correction.R +++ b/code/MOSuite/tests/testthat/test-batch-correction.R @@ -49,7 +49,8 @@ test_that("batch_correction warnings & errors", { moo |> 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" +) +```