Repository: YuLab-SMU/enrichplot Branch: devel Commit: 8adce9ad89d0 Files: 79 Total size: 260.0 KB Directory structure: gitextract_121q3_c8/ ├── .Rbuildignore ├── .dev/ │ ├── cnetplot_comparecluster_design.md │ └── manhattan_plot_plan.md ├── .gitignore ├── CONDUCT.md ├── DESCRIPTION ├── Makefile ├── NAMESPACE ├── NEWS.md ├── R/ │ ├── 00-AllClasses.R │ ├── AllGenerics.R │ ├── barplot.R │ ├── cnetplot.R │ ├── color_utils.R │ ├── data_utils.R │ ├── densityplot.R │ ├── dotplot.R │ ├── emapplot.R │ ├── emapplot_utilities.R │ ├── enrichplot-package.R │ ├── ggtable.R │ ├── goplot.R │ ├── gseaplot.R │ ├── heatplot.R │ ├── manhattanplot.R │ ├── method-fortify.R │ ├── method-ggplot-add.R │ ├── method-print.r │ ├── pairwise_termsim.R │ ├── plot_utils.R │ ├── pmcplot.R │ ├── reexport.R │ ├── ridgeplot.R │ ├── ssplot.R │ ├── treeplot.R │ ├── upsetplot.R │ ├── volplot.R │ ├── wordcloud.R │ └── zzz.R ├── README.Rmd ├── README.md ├── TODO.md ├── enrichplot.Rproj ├── man/ │ ├── as.data.frame.compareClusterResult.Rd │ ├── autofacet.Rd │ ├── barplot.enrichResult.Rd │ ├── cnetplot.Rd │ ├── color_palette.Rd │ ├── dotplot.Rd │ ├── dotplot2.Rd │ ├── emapplot.Rd │ ├── enrichplot-common-params.Rd │ ├── enrichplot-package.Rd │ ├── enrichplot-term-params.Rd │ ├── enrichplot_point_shape.Rd │ ├── fortify.Rd │ ├── geom_gsea_gene.Rd │ ├── get_enrichplot_color.Rd │ ├── ggtable.Rd │ ├── goplot.Rd │ ├── gsInfo.Rd │ ├── gseadist.Rd │ ├── gseaplot.Rd │ ├── gseaplot2.Rd │ ├── gsearank.Rd │ ├── heatplot.Rd │ ├── hplot.Rd │ ├── manhattanplot.Rd │ ├── pairwise_termsim.Rd │ ├── plotting.clusterProfile.Rd │ ├── pmcplot.Rd │ ├── reexports.Rd │ ├── ridgeplot.Rd │ ├── set_enrichplot_color.Rd │ ├── ssplot.Rd │ ├── treeplot.Rd │ ├── upsetplot-methods.Rd │ └── volplot.Rd └── vignettes/ └── enrichplot.qmd ================================================ FILE CONTENTS ================================================ ================================================ FILE: .Rbuildignore ================================================ ^.*\.Rproj$ ^\.Rproj\.user$ Makefile ^CONDUCT\.md$ README.Rmd README.md TODO.md Rplots.pdf ^\.dev$ ================================================ FILE: .dev/cnetplot_comparecluster_design.md ================================================ # compareCluster cnetplot Design Draft ## Goal Update `enrichplot::cnetplot.compareClusterResult()` so that `compareCluster` pies behave consistently with the newer `ggtangle::cnetplot()` sizing model, while keeping the current visual style and minimizing API breakage. The immediate goals are: - Make `categorySizeBy` actually affect category pie size for `compareClusterResult`. - Clarify how pie colors should be customized. - Align `enrichplot` documentation with the current `ggtangle` semantics. ## Current State ### Data Flow - `cnetplot.enrichResult()` and `cnetplot.gseaResult()` convert the enrichment object to gene sets, attach numeric term-level columns as attributes, and pass `categorySizeBy` through to `ggtangle::cnetplot()`. - `cnetplot.compareClusterResult()` takes a different route: - `tidy_compareCluster()` produces a long data frame. - Gene sets are reconstructed from `Description`. - `ggtangle::cnetplot()` is called with `size_category = 0`, `size_item = 0`, and `node_label = "none"` to generate only the network layout. - `add_node_pie()` overlays category and gene nodes with `scatterpie::geom_scatterpie()`. ### Consequences - The visible category nodes in `compareClusterResult` are not the base `ggtangle` points. They are pies added later in `add_node_pie()`. - `categorySizeBy` is currently declared in the `compareClusterResult` method signature, but it is not passed to `ggtangle::cnetplot()` and it is not used inside `add_node_pie()`. - Category pie radius is currently derived from summed `Count` values per term, scaled by `size_category`. - Pie fill colors are currently determined by the `Cluster` columns passed to `scatterpie`, not by `color_category`. ## Problem Statement The current implementation has three mismatches. ### 1. API Mismatch `categorySizeBy` is exposed for `compareClusterResult`, but the argument has no effect on the category pie radius. ### 2. Semantic Mismatch `ggtangle::cnetplot()` now supports expression/formula-based category sizing such as `~itemNum` and `~ -log10(p.adjust)`, but the `compareClusterResult` path still uses a hard-coded size computation based on total `Count`. ### 3. Documentation Mismatch The `enrichplot` docs still describe `categorySizeBy` using the older wording ("itemNum", "pvalue", "p.adjust", "qvalue" or numeric vector), which no longer reflects the current `ggtangle` interface. ## Design Principles - Preserve the current `compareCluster` visual style based on pies. - Keep the change local to `enrichplot`; do not require new behavior from `ggtangle`. - Reuse `ggtangle` sizing semantics as much as practical. - Prefer minimal API expansion. - Avoid silently changing gene-node pie behavior unless explicitly intended. ## Proposed Changes ### 1. Separate Layout Generation from Pie Radius Computation Keep the current two-step approach: - Step 1: use `ggtangle::cnetplot()` only to compute layout and edges. - Step 2: use `add_node_pie()` to draw visible nodes. No change is needed to the basic rendering architecture. ### 2. Introduce a Term-Level Size Evaluation Step Add an internal helper that computes one numeric size value per category term before pies are drawn. Suggested helper: - `compute_comparecluster_category_size(d, categorySizeBy)` Responsibilities: - Start from the `tidy_compareCluster()` output. - Build one row per `Description`. - Preserve numeric term-level columns needed for evaluation, such as: - `Count` summary - `pvalue` - `p.adjust` - `qvalue` - any other numeric columns that are constant within a term - Add an explicit `itemNum` column representing the number of unique genes in each term. - Evaluate `categorySizeBy` against this term-level data. ### 3. Adopt Formula/Expression Semantics for `compareClusterResult` Normalize `categorySizeBy` in `cnetplot.compareClusterResult()` to match `ggtangle::cnetplot.list()` behavior: - Default to `~itemNum`. - Accept bare expressions such as `p.adjust`. - Accept formulas such as `~ -log10(p.adjust)`. - Accept scalar numeric values, which should recycle to all categories. This avoids having `compareClusterResult` behave differently from `enrichResult`. ### 4. Use Evaluated Size Values as Pie Radius Inputs Modify `add_node_pie()` to accept precomputed category size values. Suggested signature: - `add_node_pie(p, d, pie = "equal", category_scale = 1, item_scale = 1, category_size = NULL)` Behavior: - If `category_size` is `NULL`, preserve existing `Count`-based behavior for backward compatibility. - If `category_size` is provided, map it to category `Description` and use it as the base value for pie radius. Important detail: - The current code multiplies by `category_scale` twice: once when computing `dd$pathway_size`, and once again in `aes(r = pathway_size * category_scale)`. - The redesign should make scaling single-source and explicit. Recommended rule: - Compute a normalized base radius from `category_size`. - Apply `category_scale` exactly once when converting the normalized value to plotted radius. ### 5. Keep Gene Pie Size Behavior Unchanged For this change, keep gene-node pie size fixed as it is today. Reason: - The issue is specifically about category node sizing. - Changing item-node sizing in the same patch would expand scope and complicate validation. ### 6. Clarify Color Customization Strategy Do not overload `color_category` to mean pie slice fill colors. Recommended behavior: - Keep `color_category` semantics unchanged for non-pie category nodes. - Document that `compareCluster` pie slice colors are controlled by the fill scale. - In examples and docs, show customization via `scale_fill_manual()`. Optional future enhancement: - Add a new parameter such as `pie_colors = NULL` to apply a manual fill scale internally. This should not be part of the minimal fix unless a stronger convenience API is desired. ## Implementation Sketch ### `cnetplot.compareClusterResult()` - Change default `categorySizeBy` from `NULL` to `~itemNum`. - Compute `category_size <- compute_comparecluster_category_size(d, categorySizeBy)`. - Keep the existing `ggtangle::cnetplot()` call for layout generation. - Pass `category_size` into `add_node_pie()`. ### `compute_comparecluster_category_size()` - Build a term-level summary table keyed by `Description`. - Add `itemNum` as unique gene count per term. - Summarize `Count` as total term count across clusters. - For columns like `p.adjust`, `pvalue`, `qvalue`, use one representative value per term if they are invariant within term. - If a requested variable is not available, raise a clear error that names the missing field. - Validate that the evaluated result is numeric, length 1 or `n_terms`, and contains no `NA`. ### `add_node_pie()` - Use `category_size` instead of hard-coded `pathway_size` when supplied. - Normalize category radii in a stable way so legends remain interpretable. - Update the legend labeller accordingly. ## Open Design Choice ### How should pie legend labels behave when `categorySizeBy` is not `Count`? There are two reasonable options. Option A: keep a numeric radius legend only - The legend shows the numeric values produced by `categorySizeBy`. - Best for expressions like `-log10(p.adjust)`. - Most faithful to the actual radius mapping. Option B: keep the current gene-count-style legend when possible - Use count labels only when the size source is effectively count-based. - Switch to numeric-value labels for all other cases. Recommendation: - Use Option A as the general rule. - If `categorySizeBy` is exactly `~itemNum` or equivalent count-based behavior, labels can remain count-like. ## Backward Compatibility - Existing plots without `categorySizeBy` should continue to work. - Existing visual style should remain close to current behavior when using the default. - Existing code that adds `scale_fill_manual()` after `cnetplot(compareClusterResult)` should continue to work. Potential visible changes: - Default pie radii may shift slightly if the new default is implemented through normalized `itemNum` rather than the current summed `Count` rule. - Pie legend labels may change if they are tied to the new size source. ## Documentation Changes ### `R/cnetplot.R` roxygen - Update the `categorySizeBy` description for all relevant methods to match current expression/formula semantics. - For `compareClusterResult`, explicitly state that the argument controls category pie size. - Add examples using: - `categorySizeBy = ~itemNum` - `categorySizeBy = ~ -log10(p.adjust)` - `scale_fill_manual()` for cluster pie colors ### `man/cnetplot.Rd` - Regenerate documentation after roxygen updates. ### NEWS - Add an entry describing: - `categorySizeBy` now works for `compareClusterResult` category pies - pie color customization should use fill scales - improved consistency with `ggtangle::cnetplot()` ## Verification Plan ### Manual Verification Create a script under `.dev`, for example: - `.dev/test_cnetplot_comparecluster_size.R` Check at least the following cases: 1. Default `compareCluster` plot with no explicit `categorySizeBy` 2. `categorySizeBy = ~itemNum` 3. `categorySizeBy = ~ -log10(p.adjust)` 4. `categorySizeBy = 2` 5. `scale_fill_manual()` on cluster pies 6. GSEA-style `compareCluster` result if available through `core_enrichment` ### Behavior Checks - Category pie radii change when `categorySizeBy` changes. - Gene pie radii remain unchanged. - Edge layout is unaffected. - Labels still align with category nodes. - The pie legend remains readable and correctly reflects the size source. ### Error Handling Checks - Unknown variable in `categorySizeBy` gives a clear error. - Non-numeric evaluation gives a clear error. - `NA` output from the size expression gives a clear error. ## Non-Goals - Redesigning the overall `compareCluster` cnetplot appearance. - Changing gene pie size semantics. - Adding a new high-level palette API unless needed after the minimal fix. - Refactoring `enrichResult` and `gseaResult` methods beyond documentation alignment. ## Recommended Implementation Order 1. Add the internal term-level size computation helper. 2. Thread computed `category_size` into `add_node_pie()`. 3. Fix radius scaling so `category_scale` is applied exactly once. 4. Update roxygen and examples. 5. Add a small manual test script under `.dev`. ================================================ FILE: .dev/manhattan_plot_plan.md ================================================ # Manhattan Plot Implementation Plan ## Goal Implement a `manhattanplot()` function in the `enrichplot` package to visualize enrichment results as a Manhattan plot, drawing conceptual inspiration from `gprofiler2::gostplot` (Figure 1 of f1000research paper 9-709). The plot will display enriched terms across the X-axis and their significance (-log10 P-value) on the Y-axis. ## Proposed Changes ### R/AllGenerics.R - **[MODIFY] R/AllGenerics.R** Add the generic function `manhattanplot` to support S4 method dispatch. ```R #' Manhattan plot for enrichment result #' #' @title manhattanplot #' @rdname manhattanplot #' @param x enrichment result. #' @param ... additional parameters. #' @return ggplot object #' @export setGeneric("manhattanplot", function(x, ...) { standardGeneric("manhattanplot") }) ``` ### R/manhattanplot.R - **[NEW] R/manhattanplot.R** Create a new S4 method implementation file to house `manhattanplot`. - Define methods for `enrichResult`, `gseaResult`, `compareClusterResult`, `enrichResultList`, and `gseaResultList` (similar to `dotplot.R`). - **Visualization Logic**: - Use `fortify()` to convert the `x` enrichment object into a `df` data frame. - **X-axis**: Enriched terms (`Description`), ordered or grouped by category (e.g. `ONTOLOGY`, `Cluster`, or semantic similarity if `pairwise_termsim` was used). By default, they will follow the base `fortify()` order or `orderBy` parameter. Note: standard Manhattan plots space the points evenly or group by semantic similarities. - **Y-axis**: Computed significance, representing `-log10(p.adjust)` (or `-log10(pvalue)` if specified). - **Size**: Point size maps to the gene `Count`. - **Color**: Point color maps to the grouping variable (e.g., `ONTOLOGY`, dataset `Cluster`, or default to `p.adjust` gradient if un-grouped). - **Styling**: Integrate standard `enrichplot` configurations, including `theme_dose(font.size)` and `enrichplot_point_shape`. Incorporate an optional horizontal dashed line referencing significant thresholds (e.g. `yintercept = -log10(0.05)`). - Return the resulting `ggplot` object. ## Verification Plan ### Manual Verification Verification will be performed via manual inspection with standard DOSE/clusterProfiler data. A script (`.dev/test_manhattan.R`) will be composed to iteratively test: 1. **Single Enrichment**: `DOSE::enrichDO()` to ensure un-grouped Manhattan plotting handles axes and coloring correctly. 2. **Compared Clusters**: `clusterProfiler::compareCluster()` to verify grouped coloring, facet behaviors (if implemented), and spacing. 3. Check visual properties: - Make sure X-axis labels are readable or omitted effectively (Manhattan plots often omit strict x-axis text in favor of broad grouping or interactive labels). - Confirm Y-axis correctly shows the log scale of significance. - Point sizes scale predictably by `Count`. ================================================ FILE: .gitignore ================================================ .Rproj.user .Rhistory .RData *.DS_Store *html .vscode/ Rplots* *.log Rplots.pdf ================================================ FILE: CONDUCT.md ================================================ # Contributor Code of Conduct As contributors and maintainers of this project, we pledge to respect all people who contribute through reporting issues, posting feature requests, updating documentation, submitting pull requests or patches, and other activities. We are committed to making participation in this project a harassment-free experience for everyone, regardless of level of experience, gender, gender identity and expression, sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. Examples of unacceptable behavior by participants include the use of sexual language or imagery, derogatory comments or personal attacks, trolling, public or private harassment, insults, or other unprofessional conduct. Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed from the project team. Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by opening an issue or contacting one or more of the project maintainers. This Code of Conduct is adapted from the Contributor Covenant (http:contributor-covenant.org), version 1.0.0, available at http://contributor-covenant.org/version/1/0/0/ ================================================ FILE: DESCRIPTION ================================================ Package: enrichplot Title: Visualization of Functional Enrichment Result Version: 1.33.0 Authors@R: c( person(given = "Guangchuang", family = "Yu", email = "guangchuangyu@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6485-8781")), person(given = "Chun-Hui", family = "Gao", email = "gaospecial@gmail.com", role = "ctb", comment = c(ORCID = "0000-0002-1445-7939"))) Description: The 'enrichplot' package provides visualization methods for interpreting functional enrichment results from ORA or GSEA analyses. It is designed to work with the 'clusterProfiler' ecosystem and builds on 'ggplot2' for flexible and extensible graphics. Depends: R (>= 4.2.0) Imports: aplot (>= 0.2.1), DOSE, dplyr, enrichit, ggfun (>= 0.1.7), ggnewscale, ggplot2 (>= 3.5.0), ggrepel (>= 0.9.0), ggtangle (>= 0.0.9), ggtree, GOSemSim (>= 2.37.2), graphics, grid, igraph, methods, purrr, RColorBrewer, reshape2, rlang, scatterpie, stats, tidydr, utils, yulab.utils (>= 0.2.2) Suggests: AnnotationDbi, clusterProfiler, europepmc, ggarchery, ggforce, ggHoriPlot, ggplotify, ggridges, ggstar, ggtreeExtra, ggupset, glue, grDevices, gridExtra, gson, org.Hs.eg.db, quarto, scales, tibble, tidyr VignetteBuilder: quarto License: Artistic-2.0 URL: https://yulab-smu.top/contribution-knowledge-mining/ BugReports: https://github.com/GuangchuangYu/enrichplot/issues biocViews: Annotation, GeneSetEnrichment, GO, KEGG, Pathways, Software, Visualization Encoding: UTF-8 RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) ================================================ FILE: Makefile ================================================ PKGNAME := $(shell sed -n "s/Package: *\([^ ]*\)/\1/p" DESCRIPTION) PKGVERS := $(shell sed -n "s/Version: *\([^ ]*\)/\1/p" DESCRIPTION) PKGSRC := $(shell basename `pwd`) BIOCVER := RELEASE_3_23 all: rd check clean for-release: rd check-dontrun clean readme alldocs: rd rd: Rscript -e 'roxygen2::roxygenise(".")' readme: Rscript -e 'rmarkdown::render("README.Rmd")' build: # cd ..;\ # R CMD build $(PKGSRC) Rscript -e 'devtools::build()' build2: cd ..;\ R CMD build --no-build-vignettes $(PKGSRC) install: cd ..;\ R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz check: # cd ..;\ # Rscript -e 'rcmdcheck::rcmdcheck("$(PKGNAME)_$(PKGVERS).tar.gz")' Rscript -e 'devtools::check()' check-dontrun: build cd ..;\ Rscript -e 'rcmdcheck::rcmdcheck("$(PKGNAME)_$(PKGVERS).tar.gz", args=c("--run-dontrun"))' check2: build cd ..;\ R CMD check $(PKGNAME)_$(PKGVERS).tar.gz bioccheck: cd ..;\ Rscript -e 'BiocCheck::BiocCheck("$(PKGNAME)_$(PKGVERS).tar.gz")' clean: cd ..;\ $(RM) -r $(PKGNAME).Rcheck/ rmrelease: git branch -D $(BIOCVER) release: git checkout $(BIOCVER);\ git fetch --all update: git fetch --all;\ git checkout devel;\ git merge upstream/devel;\ git merge origin/devel push: git push upstream devel;\ git push origin devel biocinit: git remote add upstream git@git.bioconductor.org:packages/$(PKGNAME).git;\ git fetch --all ================================================ FILE: NAMESPACE ================================================ # Generated by roxygen2: do not edit by hand S3method(as.data.frame,compareClusterResult) S3method(barplot,compareClusterResult) S3method(barplot,enrichResult) S3method(cnetplot,compareClusterResult) S3method(cnetplot,enrichResult) S3method(cnetplot,gseaResult) S3method(fortify,compareClusterResult) S3method(fortify,enrichResult) S3method(fortify,gseaResult) S3method(ggplot_add,autofacet) S3method(print,enrichplotDot) export(autofacet) export(cnetplot) export(color_palette) export(dotplot) export(dotplot2) export(emapplot) export(facet_grid) export(geneID) export(geneInCategory) export(geom_cnet_label) export(geom_gsea_gene) export(get_enrichplot_color) export(ggtable) export(ggtitle) export(goplot) export(gseaScores) export(gseadist) export(gseaplot) export(gseaplot2) export(gsearank) export(heatplot) export(hplot) export(manhattanplot) export(plot_list) export(pmcplot) export(ridgeplot) export(set_enrichplot_color) export(ssplot) export(theme_dose) export(treeplot) export(upsetplot) export(volplot) exportMethods(dotplot) exportMethods(emapplot) exportMethods(goplot) exportMethods(gseaplot) exportMethods(heatplot) exportMethods(manhattanplot) exportMethods(pairwise_termsim) exportMethods(ridgeplot) exportMethods(ssplot) exportMethods(treeplot) exportMethods(upsetplot) exportMethods(volplot) import(GOSemSim) importClassesFrom(enrichit,compareClusterResult) importFrom(DOSE,theme_dose) importFrom(RColorBrewer,brewer.pal) importFrom(aplot,plot_list) importFrom(dplyr,"%>%") importFrom(dplyr,arrange) importFrom(dplyr,bind_rows) importFrom(dplyr,desc) importFrom(dplyr,group_by) importFrom(dplyr,mutate) importFrom(dplyr,slice_head) importFrom(dplyr,ungroup) importFrom(enrichit,geneID) importFrom(enrichit,geneInCategory) importFrom(enrichit,gseaScores) importFrom(ggfun,"%<+%") importFrom(ggnewscale,new_scale_colour) importFrom(ggnewscale,new_scale_fill) importFrom(ggplot2,"%+%") importFrom(ggplot2,aes) importFrom(ggplot2,annotation_custom) importFrom(ggplot2,coord_equal) importFrom(ggplot2,coord_fixed) importFrom(ggplot2,coord_flip) importFrom(ggplot2,element_blank) importFrom(ggplot2,element_line) importFrom(ggplot2,element_rect) importFrom(ggplot2,element_text) importFrom(ggplot2,facet_grid) importFrom(ggplot2,fortify) importFrom(ggplot2,geom_bar) importFrom(ggplot2,geom_blank) importFrom(ggplot2,geom_boxplot) importFrom(ggplot2,geom_col) importFrom(ggplot2,geom_density) importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_jitter) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_linerange) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_rect) importFrom(ggplot2,geom_segment) importFrom(ggplot2,geom_text) importFrom(ggplot2,geom_tile) importFrom(ggplot2,geom_violin) importFrom(ggplot2,geom_vline) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggplotGrob) importFrom(ggplot2,ggplot_add) importFrom(ggplot2,ggplot_build) importFrom(ggplot2,ggplot_gtable) importFrom(ggplot2,ggtitle) importFrom(ggplot2,guide_colorbar) importFrom(ggplot2,guide_legend) importFrom(ggplot2,guides) importFrom(ggplot2,labs) importFrom(ggplot2,margin) importFrom(ggplot2,rel) importFrom(ggplot2,scale_color_continuous) importFrom(ggplot2,scale_color_gradient) importFrom(ggplot2,scale_color_gradientn) importFrom(ggplot2,scale_color_manual) importFrom(ggplot2,scale_fill_continuous) importFrom(ggplot2,scale_fill_discrete) importFrom(ggplot2,scale_fill_gradient2) importFrom(ggplot2,scale_fill_gradientn) importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_size) importFrom(ggplot2,scale_size_continuous) importFrom(ggplot2,scale_x_continuous) importFrom(ggplot2,scale_x_reverse) importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,scale_y_discrete) importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(ggplot2,theme_classic) importFrom(ggplot2,theme_minimal) importFrom(ggplot2,theme_void) importFrom(ggplot2,xlab) importFrom(ggplot2,xlim) importFrom(ggplot2,ylab) importFrom(ggrepel,geom_label_repel) importFrom(ggrepel,geom_text_repel) importFrom(ggtangle,cnetplot) importFrom(ggtangle,geom_cnet_label) importFrom(ggtangle,geom_edge) importFrom(ggtree,geom_cladelab) importFrom(ggtree,geom_hilight) importFrom(ggtree,geom_tiplab) importFrom(ggtree,geom_tippoint) importFrom(ggtree,ggtree) importFrom(ggtree,gheatmap) importFrom(ggtree,groupClade) importFrom(graphics,barplot) importFrom(grid,arrow) importFrom(grid,gpar) importFrom(grid,unit) importFrom(igraph,'E<-') importFrom(igraph,'V<-') importFrom(igraph,E) importFrom(igraph,V) importFrom(igraph,add_vertices) importFrom(igraph,delete.edges) importFrom(igraph,graph.empty) importFrom(igraph,graph_from_data_frame) importFrom(methods,is) importFrom(methods,setGeneric) importFrom(methods,setOldClass) importFrom(purrr,map_df) importFrom(rlang,.data) importFrom(rlang,check_installed) importFrom(rlang,sym) importFrom(scatterpie,geom_scatterpie) importFrom(scatterpie,geom_scatterpie_legend) importFrom(stats,as.dist) importFrom(stats,cutree) importFrom(stats,hclust) importFrom(stats,quantile) importFrom(stats,setNames) importFrom(tidydr,theme_dr) importFrom(utils,data) importFrom(utils,getFromNamespace) importFrom(utils,head) importFrom(utils,modifyList) importFrom(yulab.utils,check_input) importFrom(yulab.utils,get_cache_item) importFrom(yulab.utils,str_wrap) importFrom(yulab.utils,yulab_abort) importFrom(yulab.utils,yulab_msg) importFrom(yulab.utils,yulab_warn) ================================================ FILE: NEWS.md ================================================ # enrichplot 1.32.0 + Bioconductor RELEASE_3_23 (2026-04-29, Wed) # enrichplot 1.31.5 + `cnetplot.compareClusterResult()` now supports `categorySizeBy` for category pie sizing and aligns docs with `ggtangle::cnetplot()` semantics (2026-04-22, Wed) + `ridgeplot` now supports `stat` parameter (default is 'density_ridges' and can be changed to 'binline') (2026-04-01, Wed, #343) + manhattan plot for enriched result (2026-03-26, Thu) + update roxygen document to use markdown syntax (2026-03-02, Mon) + bug fixed in xy-lab format in `ssplot()` (2026-03-02, Mon) + bug fixed in formula supports in `dotplot()` (2026-02-26, Thu) # enrichplot 1.31.4 + fix `cnetplot()` S3 generic/method consistency warnings (2026-01-14, Wed) + fix `treeplot()` column selection bug when color variable equals size variable (2026-01-14, Wed) + fix `fortify.compareClusterResult()` warnings about missing imports and global variables (2026-01-14, Wed) + remove `plyr` and use `dplyr` in `method-fortify.R` (2026-01-14, Wed) + fixed `treeplot()` issue where `pairwise_termsim()` with method="JC" produced unnamed similarity matrix, causing "undefined column selected" error (2025-01-14) + fixed `fortify.compareClusterResult()` warning "NAs introduced by coercion" when Cluster names are not numeric (2025-01-14) + bug fixed in `barplot()` as `fortify()` generic in `ggplot2` checks for unused arguments in `...` (2026-01-14, Wed) + remove `categorySize` parameter in `cnetplot()` (2026-01-14, Wed) + bug fixed in `goplot()` as `GOSemSim` uses cache (2026-01-13, Tue) - also fix `gotbl` object not found issue (2026-01-13, Tue) + re-export `geneID`, `geneInCategory` and `gseaScores` from 'enrichit' (2026-01-12, Mon) + update documentation: fix typos, grammar errors and use modern markdown syntax (2026-01-12, Mon) + bug fixed in `update_n()` if `showCategory` is a vector of term names (2026-01-08, Thu) + avoid the "condition has length > 1" error in `outer()` by using `Vectorize()` (2026-01-08, Thu) # enrichplot 1.31.3 + use 'enrichit' package (2025-12-07, Sun) + optimize source code (2025-12-02, Tue) + error handling functions imported from 'yulab.utils' (2025-12-01, Mon) # enrichplot 1.31.2 + add 'fc_threshold' parameter to `cnetplot` (2025-11-30, Sun, #338) - requires 'ggtangle' v>= 0.0.9 + update all line width aes mapping from 'size' to 'linewidth' (2025-11-30, Sun) + add 'node_label_size' parameter for `emapplot` (2025-11-30, Sun) + remove `emapplot` parameters, 'group', 'group_style' and 'label_group_style' (#339) + add 'showTop' parameter to limit number of genes shown in `heatplot()` and distinguish tip point size variable for `treeplot()` through internal parameter `size_var` (2025-11-23, Sat, #335) # enrichplot 1.31.1 + import `ggfun::%<+%` (2025-11-18, Tue) + update `ssplot()`, `treeplot()` and `get_wordcloud()` (2025-11-15, Sat) + change `set_enrichplot_color(transform = 'identity')` as default behavior (2025-11-11, Tue) - now it only sets the color scale without changing the transform method - explicitly set `transform = 'log10'` in `dotplot` + use 'quarto' as vignette engine (2025-11-11, Tue) + use `set_enrichplot_color(transform = 'identity')` in `heatplot` (2025-11-11, Tue) + use `set_enrichplot_color(transform = 'identity')` in `cnetplot` (2025-11-05, Wed) # enrichplot 1.30.0 + Bioconductor RELEASE_3_22 (2025-11-01, Sat) # enrichplot 1.29.4 + remove deprecated `aes_string`/`aes_` (2025-10-23, Thu, #332) # enrichplot 1.29.3 + bug fixed of `cnetplot` for `CompareClusterResult` (2025-09-13, Sat, #329) - color gene according to the gene cluster info + bug fixed in pie scale label (2025-07-14, Mon, #328) # enrichplot 1.29.2 + update `treeplot` with two parameters, `leave_fontsize` and `clade_fontsize` (2025-07-12, Sat, #324, #325) - remove the `fontsize` parameter as it only works for `clade_fontsize` + 'log10' transform for pvalue color scale by default (2025-07-12, Sat, #316) + introduce new parameters in `gseaplot2()` (2025-07-12, Sat) - `pvalue_table_columns` - `pvalue_table_rownames` - # enrichplot 1.29.1 + throw error in `goplot()` if ontology is not one of the 'MF', 'CC' or 'BP' (2025-04-28, Mon, clusterProfiler#768) # enrichplot 1.28.0 + Bioconductor RELEASE_3_21 (2025-04-17, Thu) # enrichplot 1.27.5 + able to scale pie size for 'compareClusterResult' (2025-03-11, Tue, #308, #311) # enrichplot 1.27.4 + adjust pie size and category label position in `cnetplot()` (2025-01-08, Wed, #306) + clean up code (2024-12-20, Fri) # enrichplot 1.27.3 + scale pies and add pie legend in `emapplot()` (2024-12-12, Thu, #304) + a safe way to extract gene sets in `ridgeplot()` (2024-12-12, Thu, #303) # enrichplot 1.27.2 + `emapplot()` now allows passing color to a specific color, e.g., color = "black" (2024-11-29, Fri, #300) + bug fixed in `emapplot()` - `size_category` now works for pie node (2024-11-29, Fri, #301) - legend of term nodes will be retained when `group = TRUE` (2024-11-29, Fri, #300) + supports passing ID to 'showCategory' in `ridgeplot()` (2024-11-06, Wed, #295) + enhancement of `cnetplot()` (2024-11-06, Wed) - 'node_label' can be a vector of selected items/genes to specify the items to be displayed (#293) - 'node_label' can be 'exclusive' to label genes that are uniquely belongs to categories (#253) - 'node_label' can be 'share' to label genes that are share between categories (#253) - 'node_label' can be, e.g. '> 1' or '< 1', to label genes that have log2FC values larger or smaller than the threshold (#253) - supports using `ggtangle::geom_cnet_label()` to label items/genes in independent layer (#194, #266, #267) + fixed `ridgeplot()` when selecting a specific gene set and plotting non-core genes (2024-11-06, Wed, #298) # enrichplot 1.27.1 + add 'ID' parameter in `goplot()` (2024-10-30, Wed) - # enrichplot 1.26.0 + Bioconductor RELEASE_3_20 (2024-10-30, Wed) # enrichplot 1.25.6 + pretty gene count legend (2024-10-29, Tue, #271) # enrichplot 1.25.5 + new `emaplot()`, `goplot()`, `cnetplot()` and `ssplot()`, all power by 'ggtangle' package (2024-10-24, Thu) + re-export `ggtangle::cnetplot()` (2024-10-24, Thu) + remove `drag_network()` (2024-10-24, Thu) # enrichplot 1.25.4 + fixed `goplot()` (2024-10-23, Wed, #297, #732, #718) # enrichplot 1.25.3 + `hplot()`: Horizontal plot for GSEA result (2024-08-27, Tue) # enrichplot 1.25.2 + fixed bug in `ridgeplot()` (2024-08-19, Mon, clusterProfiler#704) # enrichplot 1.25.1 + fixed GeneRatio in dotplot as character of fraction issue (2024-08-16, Fri, clusterProfiler#715) + use `yulab.utils::yulab_msg()` for startup message (2024-07-26, Fri) + `dotplot2` to compare two selected clusters in 'compareClusterResult' object (2024-06-15, Sat) + `volplot` to visualize ORA result using volcano plot (2024-06-13, Thu) # enrichplot 1.24.0 + Bioconductor RELEASE_3_19 (2024-05-15, Wed) # enrichplot 1.23.2 + separate the JC similarity method (2023-12-11, Mon, #265) + fix the issue in `ridgeplot(showCategory)` : support a vector of Description, not ID(2023-12-1, Fri, #193) # enrichplot 1.23.1 + `ridgeplot()` supports passing a vector of selected pathways via the 'showCategory' parameter (2023-11-30, Thu, #193) + fix `treeplot()` to compatible with the current version of ggtree and ggtreeExtra. (2023-10-28, Sat) + add clusterPanel.params[["colnames_angle"]] parameter to set the angle of colnames. (2023-10-28, Sat) # enrichplot 1.22.0 + Bioconductor RELEASE_3_18 (2023-10-25, Wed) # enrichplot 1.21.3 + `set_enrichplot_color()`, a helper function to set colors (2023-09-13, Wed) - change default color: from c("red", "blue") to c("#e06663", "#327eba") + use `check_installed()` to check package dependency (2023-09-08, Fri, #254) # enrichplot 1.21.2 + introduce 'facet' parameter in `dotplot()` method for `compareClusterResult`. If `facet = "intersect"`, the dots will be separated by enriched pathway intersection among clusters. It can set to other variable that can be used for splitting the figure (e.g., "category" for KEGG results) (2023-08-21, Mon) # enrichplot 1.21.1 + fixed `cnetplot.compareClusterResult()` for only contains one cluster (2023-05-24, Wed, #243) # enrichplot 1.20.0 + Bioconductor RELEASE_3_17 (2023-05-03, Wed) # enrichplot 1.19.2 + fix `emapplot()` for parameter mismatch (2023-02-20, Mon) + fix `ridgeplot` for error when x@readable == TRUE and length(x@gene2Symbol) = 0 (2022-12-5, Mon) + fix `ridgeplot` for error when `x@readable == TRUE` and `length(x@gene2Symbol) = 0` (2022-12-5, Mon, #217) # enrichplot 1.19.1 + fix `cnetplot()` for `node_label` parameter is flipped(2022-12-04, Sun, #216) + bug fixed in `treeplot()` (2022-11-18, Fri) + enable `dotplot()` and `autofacet()` for `gseaResultList` object # enrichplot 1.18.0 + Bioconductor RELEASE_3_16 (2022-11-02, Wed) # enrichplot 1.17.4 + rename parameters of `emapplot()`, `centplot()` and `treeplot()` (2022-09-11, Sun) # enrichplot 1.17.3 + align the dots in `treeplot()` (2022-10-1, Sat) + fix a bug in color legend of `treeplot()` (2022-10-1, Sat) # enrichplot 1.17.2 + `autofacet` to automatically split `barplot` and `dotplot` into several facets (2022-09-06, Tue) + `dotplot` method for `enrichResultList` object + add parameters `hilight_category`, `alpha_hilight`, `alpha_nohilight` for `cnetplot()` and `emapplot` (2022-09-4, Sun) + change round digits of cnetplot scatterpie legend to 1 (2022_8_29, Mon). + `gsearank()` can export result as a table when `output = "table"` (2022-08-29, Mon, #184) + fix a bug in `fc_readable()` (2022-08-29, Mon, #189) + allows passing `color="NES"` to `dotplot()` for `gseaResult` object (2022-08-29, Mon, #14) # enrichplot 1.17.1 + fix a bug in https://github.com/YuLab-SMU/clusterProfiler/issues/488 (2022-08-25, Thu) + support multiple gene sets in `geom_gsea_gene` layer (2022-08-25, Thu) + `geom_gsea_gene` layer (2022-08-24, Wed) + add parameters `symbol` and `pvalue` for `heatplot.enrichResult()` (2022-08-20, Sat) + change default values of `group_category` and `node_label` in `ssplot()` (2022-07-04, Mon) + update document of `ssplot()` (2022-07-04, Mon) + `gseaplot()` and `gseaplot2()` return `gglist` object instead of plotting the figure (2022-05-05, Thu) + fix `ridgeplot` when `x@readable = TRUE` (2022-04-30, Sat) # enrichplot 1.16.0 + Bioconductor 3.15 release # enrichplot 1.15.4 + update `treeplot`: support passing rel object to `offset` and `offset_tiplab` (2022-04-24, Sun) # enrichplot 1.15.3 + export `drag_network' (2022-03-07, Mon) + update `cnetplot.enrichResult` to be supported by `drag_network`(2022-3-6, Sun) + add function `drag_network` to drag the nodes of networks (2022-2-25, Fri) + fix a bug in `goplot`: `goplot.gseaResult` need `setType` slot instead of `ontology` slot (2022-2-22, Tue) + return `gg` object instead of print it in `dotplot.compareClusterResult()` (2022-01-05, Wed, @altairwei, #160) # enrichplot 1.15.2 + add `label_format_tiplab` and `label_format_cladelab` parameters for `treeplot`(2021-12-24, Fri) + support treeplot of compareCluster(GSEA algorithm) result(2021-12-13, Mon) + support visualization of compareCluster(GSEA algorithm) result(2021-12-11, Sat) + support scientific notation for `gseaplot2`(2021-12-4, Sat) # enrichplot 1.15.1 + fixed R check by importing `utils` # enrichplot 1.14.0 + Bioconductor 3.14 release # enrichplot 1.13.2 + mv `ep_str_wrap` to `yulab.utils::str_wrap` (2021-10-13, Wed) + adjust the order of legends for `dotplot`, `emapplot`, `cnetplot` and `treeplot`(2021-10-8, Fri) + update `treeplot`: add "dotplot" and "heatmap" panels for `treeplot`(2021-9-15, Wed) + update `dotplot`: enable `size` parameter applicable to other columns of compareClusterResult(2021-9-17, Fri) + enable `label_format` parameter for `heatplot` (2021-09-01, Wed) + add `get_ggrepel_segsize` function to set `segment.size` value for `ggrepel`(2021-08-29, Sun) + update `ep_str_wrap` (2021-08-28, Sat) + `cnetplot` now works with a named list (2021-08-23, Mon; clusterProfiler#362) # enrichplot 1.13.1 + use `aplot::plot_list` instead of `cowplot::plot_grid` (2021-06-13, Sun + add `color_category` and `color_gene` parameters for `cnetplot`(2021-6-11, Fri) + Enables `showCategory` parameter to support character input in `dotplot.compareClusterResult`(2021-6-10, Thu) # enrichplot 1.12.0 + Bioconductor 3.13 release # enrichplot 1.11.3 + add function `ssplot` for similarity space plot. (2021-4-22, Thu). + Reconstruct the `emapplot` function and replace `emapplot_cluster` by `emapplot(group_category = TRUE)` + fix bug in `emapplot_cluster.enrichResult` when the number of cluster is 2 (2021-2-24, Wed). + fix bug in `treeplot`: The legend is not the right size (2021-2-6, Sat). + fix `dotplot` for `label_format` parameter doesn't work(2021-2-3, Wed). + fix bug in `gseaplot2`(2021-1-28, Thu) # enrichplot 1.11.2 + update document (2021-1-7, Thu) + update `dotplot`: replace `ggsymbol::geom_symbol` with `ggstar::geom_star`(2021-1-6, Wed) + add parameter `shadowtext` for three functions: `emapplot`, `emapplot_cluster` and `cnetplot`. (2021-1-5, Tue) + update `dotplot`: supports the use of shapes and line colors to distinguish groups (2021-1-3, Sun) + add `treeplot` function (2020-12-29, Tue) + rename function `get_ww` to `get_similarity_matrix` (2020-12-29, Tue) + move the `emapplot` related functions to emapplot_utilities.R + fix bug in `emapplot` and `cnetplot` when enrichment result is one line (2020-12-26, Sat) + fix `pairwise_termsim` for the bug of repeated filtering of `showCategory`(2020-12-23, Wed) + fix `showCategory` for `cnetplot`, `emapplot`, `emapplot_cluster` when `showCategory` is a vector of term descriptions # enrichplot 1.11.1 + add `orderBy` and `decreasing` parameters for `ridgeplot()` (2020-11-19, Thu) - + update `emapplot_cluster()` to label cluster in center by default and use `ggrepel` if setting `repel = TRUE` (2020-11-08, Mon) - + add a `label_format` parameter to support formatting label (2020-10-28, Wed) + if provided with a numeric value will simply string wrap by default + if provided with a function will instead set labels = user_defined_function() within the scale function + # enrichplot 1.10.0 + Bioconductor 3.12 release (2020-10-28, Wed) # enrichplot 1.9.5 + fix `wordcloud_i` (2020-10-15, Thu) + Remove similarity calculation from emapplot # enrichplot 1.9.4 + implement `pairwise_termsim` to calculate similarity of enriched terms (2020-10-09, Fri) - + change parameters to be more consistent - # enrichplot 1.9.3 + add `node_label_size` parameter to adjust the size of node label in `emapplot` function (2020-09-18, Fri) # enrichplot 1.9.2 + add function `emapplot_cluster` (2020-09-01, Tue) # enrichplot 1.7.3 + update `barplot` to remove using `coord_flip()` (2020-09-10, Thu) + update `cnetplot` color scale to tolerate with skewed foldchange (2020-03-13, Fri) - # enrichplot 1.7.1 + `cnetplot` for `compareClusterResult` (`compareCluster` output) (2019-12-02, Mon) + move `barplot`, `dotplot` and `fortify` methods of `compareClusterResult` from `clusterProfiler` (2019-11-2, Sat) # enrichplot 1.6.0 + Bioconductor 3.10 release # enrichplot 1.5.2 + update `node_label` parameter in `cnetplot` to support selection of subset to be labeled (2019-09-27, Fri) - + `upsetplot` for `gseaResult` (2019-09-25, Wed) + reimplement `upsetplot` based on `ggupset` # enrichplot 1.5.1 + `gseadist` for plotting logFC distribution of selected gene sets. (2019-06-25, Tue) # enrichplot 1.4.0 + Bioconductor 3.9 release # enrichplot 1.3.2 + `dotplot` supports setting `x` to other variable, e.g. NES (2019-01-10, Thu) + mv vignette to [clusterProfiler-book](https://yulab-smu.github.io/clusterProfiler-book/). # enrichplot 1.2.0 + Bioconductor 3.8 release # enrichplot 1.1.5 + `gsearank` for plotting ranked list of genes belong to specific gene set (2018-07-04, Wed) # enrichplot 1.1.4 + `base_size` parameter in `gseaplot2` (2018-06-21, Thu) # enrichplot 1.1.3 + `pmcplot` for plotting pubmed trend (2018-06-14, Thu) + `ggtable` for plotting table + `gseaplot2` now accepts a vector of `geneSetID` (2018-06-13, Wed) # enrichplot 1.1.2 + `emapplot` supports `showCategory` parameter to accept a vector of `Description` (2018-05-29, Tue) + bug fixed of `showCategory` parameter for vector of `Description` in `cnetplot` - + `gseaplot2` that mimic the figure generated by broad institute's GSEA software (2018-05-28, Mon) # enrichplot 1.1.1 + `cnetplot` supports `showCategory` parameter to accept a vector of `Description` - # enrichplot 1.0.0 + Bioconductor 3.7 release # enrichplot 0.99.14 + `node_label = TRUE` parameter in `cnetplot` (2018-04-08, Sun ) + drop NA in `dotplot` <2018-03-19, Mon> - + enable using formula to specify x axis in `dotplot` # enrichplot 0.99.13 + fixed `goplot` issue by imporint `ggraph` <2018-03-12, Mon> - - >Error in grid.Call(C_convert, x, as.integer(whatfrom), as.integer(whatto), : >invalid line type + `dotplot` now supports `orderBy` and `decreasing` parameters to specify the order of dots by `order(x[[orderBy]], decreasing=decreasing)` # enrichplot 0.99.9 + defined `upsetplot` (2018-01-30, Tue) + all visualization methods were defined as `S4` methods (2018-01-29, Mon) # enrichplot 0.99.5 + defined all visualization functions as generic functions (2018-01-03, Wed) + add `colorEdge` parameter in `cnetplot` + update docs enrichplot 0.99.3 ------------------------ + import `ggplot2::rel` to fix R check (2017-11-28, Tue) enrichplot 0.99.0 ------------------------ + ready to submit to Bioconductor (2017-11-28, Tue) enrichplot 0.0.3 ------------------------ + `heatplot` and `gseaplot` (2017-11-28, Tue) + `ridgeplot`, `barplot` and `dotplot` derived from `DOSE` (2017-11-28, Tue) + `cnetplot` (2017-11-28, Tue) enrichplot 0.0.2 ------------------------ + vignette added (2017-11-28, Tue) + `goplot` for plotting induced GO DAG (2017-11-27, Mon) enrichplot 0.0.1 ------------------------ + `emapplot` for plotting enrichment map (2017-11-23) ================================================ FILE: R/00-AllClasses.R ================================================ #' @importFrom methods setOldClass setOldClass("enrichResultList") setOldClass("gseaResultList") ================================================ FILE: R/AllGenerics.R ================================================ #' Dot plot for enrichment result #' #' #' @title dotplot #' @rdname dotplot #' @param object input object. #' @param ... additional parameters. #' @return plot. #' @importFrom methods setGeneric #' @export #' @examples #' \dontrun{ #' library(DOSE) #' data(geneList) #' de <- names(geneList)[1:100] #' x <- enrichDO(de) #' dotplot(x) #' # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. #' dotplot(x, showCategory = 10) #' categories <- c("pre-malignant neoplasm", "intestinal disease", #' "breast ductal carcinoma", "non-small cell lung carcinoma") #' dotplot(x, showCategory = categories) #' # It can also graph compareClusterResult #' data(gcSample) #' library(clusterProfiler) #' library(DOSE) #' library(org.Hs.eg.db) #' data(gcSample) #' xx <- compareCluster(gcSample, fun="enrichGO", OrgDb="org.Hs.eg.db") #' xx2 <- pairwise_termsim(xx) #' library(ggstar) #' dotplot(xx2) #' dotplot(xx2, shape = TRUE) #' dotplot(xx2, group = TRUE) #' dotplot(xx2, x = "GeneRatio", group = TRUE, size = "count") #' } #' @author Guangchuang Yu setGeneric("dotplot", function(object, ...) { standardGeneric("dotplot") }) #' Shared term-plot parameters #' #' @name enrichplot-term-params #' @param showCategory number of categories to display, or a vector of terms. #' @param color variable used to color enriched terms, e.g. `'pvalue'`, #' `'p.adjust'`, or `'qvalue'`. #' @param label_format a numeric wrap width, or a custom function to format #' axis labels. #' @keywords internal NULL #' Shared parameters for enrichment plots #' #' @name enrichplot-common-params #' @param color variable used to color enriched terms, e.g. `'pvalue'`, #' `'p.adjust'`, or `'qvalue'`. #' @param showCategory number of categories to display, or a vector of terms. #' @param size variable used to scale category size, one of `"geneRatio"`, #' `"Percentage"`, or `"count"`. #' @param split apply `showCategory` to each category specified by `split`, #' e.g., `"ONTOLOGY"`, `"category"`, or `"intersect"`. Default is `NULL`. #' @param font.size font size. #' @param title figure title. #' @param label_format a numeric wrap width, or a custom function to format #' axis labels. #' @param includeAll logical value. #' @keywords internal NULL #' Enrichment Map for enrichment result of #' over-representation test or gene set enrichment analysis #' #' #' This function visualizes gene sets as a network (i.e. enrichment map). #' Mutually overlapping gene sets tend to cluster together, making it #' easier for interpretation. When the similarity between terms meets #' a certain threshold (default is 0.2, adjusted by parameter `min_edge`), #' there will be edges between terms. The stronger the similarity, #' the shorter and thicker the edges. The similarity between terms is #' obtained by the function `pairwise_termsim`. Details of the similarity #' calculation can be found in its documentation: [pairwise_termsim()]. #' @title emapplot #' @rdname emapplot #' @param x Enrichment result. #' @param showCategory number of categories to display or a vector of terms. #' @param ... Additional parameters #' @return ggplot object #' @export #' @examples #' \dontrun{ #' library(DOSE) #' data(geneList) #' de <- names(geneList)[1:100] #' x <- enrichDO(de) #' x2 <- pairwise_termsim(x) #' emapplot(x2) #' # use `layout` to change the layout of map #' emapplot(x2, layout = "star") #' # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. #' emapplot(x2, showCategory = 10) #' categories <- c("pre-malignant neoplasm", "intestinal disease", #' "breast ductal carcinoma") #' emapplot(x2, showCategory = categories) #' #' # It can also graph compareClusterResult #' library(clusterProfiler) #' library(DOSE) #' library(org.Hs.eg.db) #' data(gcSample) #' xx <- compareCluster(gcSample, fun="enrichGO", OrgDb="org.Hs.eg.db") #' xx2 <- pairwise_termsim(xx) #' emapplot(xx2) #' } #' @author Guangchuang Yu setGeneric("emapplot", function(x, ...) { standardGeneric("emapplot") }) #' Get the similarity matrix #' #' #' This function adds a similarity matrix to the termsim slot of the enrichment result. #' Users can use the `method` parameter to select the method of calculating the similarity. #' The Jaccard correlation coefficient (JC) is used by default, and it applies to all situations. #' When users want to calculate the correlation between GO terms or DO terms, they can also choose #' "Resnik", "Lin", "Rel" or "Jiang" (they are semantic similarity calculation methods from the 'GOSemSim' package), #' and at this time, the user needs to provide the `semData` parameter, which can be obtained through #' [GOSemSim::godata()]. #' @title pairwise_termsim #' @rdname pairwise_termsim #' @param x enrichment result. #' @param method method of calculating the similarity between nodes, #' one of "Resnik", "Lin", "Rel", "Jiang", "Wang", and #' "JC" (Jaccard similarity coefficient) methods. #' @param semData `GOSemSimDATA` object, can be obtained through #' `GOSemSim::godata`. #' @param showCategory number of enriched terms to be calculated. The default value is the number of enriched terms, or 200 if the number of enriched terms exceeds 200. #' @examples #' \dontrun{ #' library(clusterProfiler) #' library(org.Hs.eg.db) #' library(enrichplot) #' library(GOSemSim) #' library(DOSE) #' data(geneList) #' gene <- names(geneList)[abs(geneList) > 2] #' ego <- enrichGO(gene = gene, #' universe = names(geneList), #' OrgDb = org.Hs.eg.db, #' ont = "BP", #' pAdjustMethod = "BH", #' pvalueCutoff = 0.01, #' qvalueCutoff = 0.05, #' readable = TRUE) #' d <- godata('org.Hs.eg.db', ont="BP") #' ego2 <- pairwise_termsim(ego, method="Wang", semData = d) #' emapplot(ego2) #' emapplot_cluster(ego2) #' } setGeneric( "pairwise_termsim", function(x, method = "JC", semData = NULL, showCategory = NULL) { standardGeneric("pairwise_termsim") } ) #' Plot induced GO DAG of significant terms #' #' #' @title goplot #' @rdname goplot #' @param x enrichment result. #' @inheritParams enrichplot-term-params #' @param layout layout of the map #' @param geom label geom, one of 'label' or 'text' #' @param ... additional parameters. #' @return ggplot object #' @export #' @examples #' \dontrun{ #' library(clusterProfiler) #' data(geneList, package = "DOSE") #' de <- names(geneList)[1:100] #' yy <- enrichGO(de, 'org.Hs.eg.db', ont="BP", pvalueCutoff=0.01) #' goplot(yy) #' goplot(yy, showCategory = 5) #' } #' @author Guangchuang Yu setGeneric( "goplot", function( x, showCategory = 10, color = "p.adjust", layout = "sugiyama", geom = "text", ... ) { standardGeneric("goplot") } ) #' Visualize GSEA analysis results #' #' Plotting function for gseaResult #' @title gseaplot #' @rdname gseaplot #' @param x gseaResult object #' @param geneSetID geneSet ID #' @param by one of "runningScore" or "position" #' @param title plot title #' @param ... additional parameters #' @return ggplot2 object #' @export #' @examples #' \donttest{ #' library(DOSE) #' data(geneList) #' x <- gseDO(geneList) #' gseaplot(x, geneSetID=1) #' } #' @author Guangchuang Yu setGeneric("gseaplot", function(x, geneSetID, by = "all", title = "", ...) { standardGeneric("gseaplot") }) #' Heatmap-like plot for functional classification #' #' #' @title heatplot #' @rdname heatplot #' @param x enrichment result. #' @param showCategory number of enriched terms to display #' @param foldChange fold change. #' @param label_format a numeric value setting the wrap length, alternatively a #' custom function to format axis labels. #' @param ... Additional parameters #' @export #' @return ggplot object #' @examples #' library(DOSE) #' data(geneList) #' de <- names(geneList)[1:100] #' x <- enrichDO(de) #' heatplot(x) #' @author Guangchuang Yu setGeneric("heatplot", function(x, showCategory = 30, ...) { standardGeneric("heatplot") }) #' Volcano plot for enrichment result #' #' #' @title volplot #' @rdname volplot #' @param x enrichment result. #' @param color selected variable to color the dots #' @param xintercept value to set x-intercept #' @param yintercept value to set y-intercept #' @param showCategory number of most significant enriched terms or selected terms to #' display determined by the variable selected to color the dots #' @param label_format a numeric value setting the wrap length, alternatively a #' custom function to format axis labels. #' @param ... Additional parameters #' @export #' @return ggplot object #' @examples #' library(DOSE) #' data(geneList) #' de <- names(geneList)[1:100] #' x <- enrichDO(de) #' volplot(x) #' @author Guangchuang Yu setGeneric( "volplot", function( x, color = "zScore", xintercept = 1, yintercept = 2, showCategory = 5, label_format = 30, ... ) { standardGeneric("volplot") } ) #' Ridgeline plot for GSEA result #' #' #' @title ridgeplot #' @rdname ridgeplot #' @param x gseaResult object #' @param showCategory number of categories to display or a vector of terms. #' @param fill one of "pvalue", "p.adjust", "qvalue" #' @param core_enrichment whether to use only core_enriched genes #' @param label_format a numeric value setting the wrap length, alternatively a #' custom function to format axis labels. #' @param ... additional parameters. #' @return ggplot object #' @export #' @examples #' \donttest{ #' library(DOSE) #' data(geneList) #' x <- gseDO(geneList) #' ridgeplot(x) #' } #' @author Guangchuang Yu setGeneric( "ridgeplot", function( x, showCategory = 30, fill = "p.adjust", core_enrichment = TRUE, label_format = 30, ... ) { standardGeneric("ridgeplot") } ) #' upsetplot method generics #' #' #' @docType methods #' @name upsetplot #' @rdname upsetplot-methods #' @title upsetplot method #' @param x object #' @param ... additional parameters #' @return plot #' @export #' @author Guangchuang Yu setGeneric("upsetplot", function(x, ...) standardGeneric("upsetplot")) #' Functional grouping tree diagram for enrichment result of #' over-representation test or gene set enrichment analysis. #' #' #' This function visualizes gene sets as a tree. #' Gene sets with high similarity tend to cluster together, making it easier #' for interpretation. #' @title treeplot #' @rdname treeplot #' @param x enrichment result. #' @param showCategory number of enriched terms to display #' @param color variable used to color enriched terms, e.g. pvalue, #' p.adjust or qvalue #' @param label_format a numeric value setting the wrap length, alternatively a #' custom function to format axis labels. #' @param ... additional parameters #' @return ggplot object #' @export #' @examples #' \dontrun{ #' library(clusterProfiler) #' library(org.Hs.eg.db) #' library(enrichplot) #' library(GOSemSim) #' library(ggplot2) #' library(DOSE) #' data(geneList) #' gene <- names(geneList)[abs(geneList) > 2] #' ego <- enrichGO(gene = gene, #' universe = names(geneList), #' OrgDb = org.Hs.eg.db, #' ont = "BP", #' pAdjustMethod = "BH", #' pvalueCutoff = 0.01, #' qvalueCutoff = 0.05, #' readable = TRUE) #' d <- godata('org.Hs.eg.db', ont="BP") #' ego2 <- pairwise_termsim(ego, method = "Wang", semData = d) #' treeplot(ego2, showCategory = 30) #' # use `hilight = FALSE` to remove ggtree::geom_hilight() layer. #' treeplot(ego2, showCategory = 30, hilight = FALSE) #' # use `offset` parameter to adjust the distance of bar and tree. #' treeplot(ego2, showCategory = 30, hilight = FALSE, offset = rel(1.5)) #' # use `offset_tiplab` parameter to adjust the distance of nodes and branches. #' treeplot(ego2, showCategory = 30, hilight = FALSE, offset_tiplab = rel(1.5)) #' keep <- rownames(ego2@termsim)[c(1:10, 16:20)] #' keep #' treeplot(ego2, showCategory = keep) #' treeplot(ego2, showCategory = 20, #' group_color = c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442")) #' # It can also graph compareClusterResult #' data(gcSample) #' xx <- compareCluster(gcSample, fun="enrichKEGG", #' organism="hsa", pvalueCutoff=0.05) #' xx <- pairwise_termsim(xx) #' treeplot(xx) #' #' # use `geneClusterPanel` to change the gene cluster panel. #' treeplot(xx, geneClusterPanel = "dotplot") #' #' treeplot(xx, geneClusterPanel = "pie") #' } setGeneric("treeplot", function(x, ...) { standardGeneric("treeplot") }) #' Similarity Space Plot for enrichment analysis #' #' Creates 2D visualization of enrichment results using dimension reduction #' techniques to show relationships between terms based on similarity. #' #' @title ssplot #' @rdname ssplot #' @inheritParams emapplot #' @return ggplot object #' @export #' @examples #' \dontrun{ #' library(clusterProfiler) #' library(org.Hs.eg.db) #' library(enrichplot) #' library(GOSemSim) #' library(DOSE) #' data(geneList) #' gene <- names(geneList)[abs(geneList) > 2] #' ego <- enrichGO(gene = gene, #' universe = names(geneList), #' OrgDb = org.Hs.eg.db, #' ont = "BP", #' pAdjustMethod = "BH", #' pvalueCutoff = 0.01, #' qvalueCutoff = 0.05, #' readable = TRUE) #' d <- godata('org.Hs.eg.db', ont="BP") #' ego2 <- pairwise_termsim(ego, method = "Wang", semData = d) #' ssplot(ego2) #' } #' @author Guangchuang Yu setGeneric("ssplot", function(x, ...) { standardGeneric("ssplot") }) #' Manhattan plot for enrichment result #' #' @title manhattanplot #' @rdname manhattanplot #' @param x enrichment result. #' @inheritParams enrichplot-common-params #' @param ... additional parameters. #' @return ggplot object #' @export setGeneric("manhattanplot", function(x, ...) { standardGeneric("manhattanplot") }) ================================================ FILE: R/barplot.R ================================================ #' Barplot of enrichResult #' #' Barplot of enrichResult #' #' @importFrom graphics barplot #' @importFrom ggplot2 %+% #' @importFrom ggplot2 scale_fill_continuous #' @importFrom ggplot2 aes #' @importFrom ggplot2 geom_col #' @importFrom ggplot2 theme #' @importFrom ggplot2 ggtitle #' @importFrom ggplot2 xlab #' @importFrom ggplot2 ylab #' @importFrom ggplot2 scale_y_discrete #' @title barplot #' @param height enrichResult object #' @param x one of 'Count' and 'GeneRatio' #' @param color one of 'pvalue', 'p.adjust' and 'qvalue' #' @param showCategory number of categories to display or a vector of terms. #' @param font.size font size #' @param title plot title #' @param label_format a numeric value sets wrap length, alternatively a #' custom function to format axis labels. #' by default wraps names longer than 30 characters #' @param ... additional parameters #' @method barplot enrichResult #' @export #' @return ggplot object #' @examples #' library(DOSE) #' data(geneList) #' de <- names(geneList)[1:100] #' x <- enrichDO(de) #' barplot(x) #' # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. #' barplot(x, showCategory = 10) #' categories <- c("urinary bladder cancer", "bronchiolitis obliterans", #' "aortic aneurysm", "esophageal cancer") #' barplot(x, showCategory = categories) barplot.enrichResult <- function( height, x = "Count", color = 'p.adjust', showCategory = 8, font.size = 12, title = "", label_format = 30, ... ) { ## use *height* to satisy barplot generic definition ## actually here is an enrichResult object. object <- height colorBy <- match.arg(color, c("pvalue", "p.adjust", "qvalue")) if (x == "geneRatio" || x == "GeneRatio") { x <- "GeneRatio" } else if (x == "count" || x == "Count") { x <- "Count" } #df <- fortify(object, showCategory = showCategory, by = x, ...) dots <- list(...) supported_params <- c("order", "drop", "split") fortify_params <- dots[names(dots) %in% supported_params] # Create the call to fortify without passing ... directly # This prevents ggplot2 from checking for unused parameters fortify_args <- list( model = object, showCategory = showCategory, by = x ) # Add supported parameters explicitly if ("order" %in% names(fortify_params)) { fortify_args$order <- fortify_params$order } if ("drop" %in% names(fortify_params)) { fortify_args$drop <- fortify_params$drop } if ("split" %in% names(fortify_params)) { fortify_args$split <- fortify_params$split } # Use do.call to avoid passing ... through function calls df <- do.call(fortify.enrichResult, fortify_args) if (colorBy %in% colnames(df)) { p <- ggplot( df, aes( x = .data[[x]], y = .data[["Description"]], fill = .data[[colorBy]] ) ) + theme_dose(font.size) + set_enrichplot_color(type = "fill", name = color) } else { p <- ggplot( df, aes( x = .data[[x]], y = .data[["Description"]], fill = .data[["Description"]] ) ) + theme_dose(font.size) + theme(legend.position = "none") } label_func <- default_labeller(label_format) if (is.function(label_format)) { label_func <- label_format } p + geom_col() + # geom_bar(stat = "identity") + coord_flip() + scale_y_discrete(labels = label_func) + ggtitle(title) + ylab(NULL) # + xlab(NULL) } #' @method barplot compareClusterResult #' @export barplot.compareClusterResult <- function( height, color = "p.adjust", showCategory = 5, by = "geneRatio", includeAll = TRUE, font.size = 12, title = "", ... ) { ## use *height* to satisy barplot generic definition ## actually here is an compareClusterResult object. df <- fortify( height, showCategory = showCategory, by = by, includeAll = includeAll ) plotting.clusterProfile( df, type = "bar", colorBy = color, by = by, title = title, font.size = font.size ) } ================================================ FILE: R/cnetplot.R ================================================ #' Category-Gene-Network Plot #' #' Category-gene-network plot #' @rdname cnetplot #' @param x input object #' @param layout network layout #' @param showCategory number of categories to display or a vector of terms. #' @param color_category color of category nodes #' @param size_category relative size of the category nodes #' @param color_item color of item nodes #' @param size_item relative size of the item nodes (e.g., genes) #' @param color_edge color of edge #' @param size_edge relative size of edge #' @param categorySizeBy An expression (e.g., `itemNum`, `p.adjust`) or a formula #' (e.g., `~ -log10(p.adjust)`) to set the category node size. For #' `compareClusterResult`, this controls the category pie size. #' @param node_label one of 'all', 'none', 'category', 'item', 'exclusive' or 'share'. #' 'exclusive' labels genes that uniquely belong to categories; 'share' labels genes that are shared between categories. #' @param foldChange numeric values to color the item (e.g., fold change of gene expression values) #' @param fc_threshold threshold for filtering genes by absolute fold change (e.g., fc_threshold = 1 keeps only genes with |foldChange| > 1). #' @param hilight selected categories to be highlighted #' @param hilight_alpha transparency value for non-highlighted items #' @param split apply `showCategory` to each category specified by `split` for #' `compareClusterResult`, e.g. `ONTOLOGY`, `category` or `intersect`. #' @param includeAll logical value passed to `fortify()` when selecting terms #' from a `compareClusterResult`. #' @param ... additional parameters #' @importFrom ggtangle cnetplot #' @method cnetplot enrichResult #' @export #' @seealso #' [cnetplot][ggtangle::cnetplot] cnetplot.enrichResult <- function( x, layout = igraph::layout_with_kk, showCategory = 5, color_category = "#E5C494", size_category = 1, color_item = "#B3B3B3", size_item = 1, color_edge = "grey", size_edge = .5, categorySizeBy = ~itemNum, node_label = "all", foldChange = NULL, fc_threshold = NULL, hilight = "none", hilight_alpha = .3, ... ) { geneSets <- extract_geneSets(x, showCategory) foldChange <- fc_readable(x, foldChange) # Attach enrichment results to geneSets attributes y <- as.data.frame(x) # Filter y to match geneSets (names are Descriptions) # We match by Description. # Note: If duplicate Descriptions exist, this might be ambiguous, # but extract_geneSets assumes Descriptions are valid keys. idx <- match(names(geneSets), y$Description) y_subset <- y[idx, ] for (col in colnames(y_subset)) { if (is.numeric(y_subset[[col]])) { attr(geneSets, col) <- y_subset[[col]] } } args <- list(...) plot_args <- list( x = geneSets, layout = layout, showCategory = showCategory, foldChange = foldChange, fc_threshold = fc_threshold, color_category = color_category, size_category = size_category, color_item = color_item, size_item = size_item, color_edge = color_edge, size_edge = size_edge, node_label = node_label, hilight = hilight, hilight_alpha = hilight_alpha, categorySizeBy = categorySizeBy ) final_args <- c(plot_args, args) p <- do.call(cnetplot, final_args) p <- p + set_enrichplot_color( colors = get_enrichplot_color(3), name = "fold change", transform = 'identity' ) if (!is.null(foldChange)) { p <- p + guides( size = guide_legend(order = 1), color = guide_colorbar(order = 2) ) } return(p + guides(alpha = "none")) } #' @rdname cnetplot #' @method cnetplot gseaResult #' @export cnetplot.gseaResult <- cnetplot.enrichResult #' @rdname cnetplot #' @param pie one of 'equal' or 'Count' to set the slice ratio of the pies #' @method cnetplot compareClusterResult #' @export cnetplot.compareClusterResult <- function( x, layout = igraph::layout_with_kk, showCategory = 5, color_category = "#E5C494", size_category = 1, color_item = "#B3B3B3", size_item = 1, color_edge = "grey", size_edge = .5, categorySizeBy = ~itemNum, node_label = "all", foldChange = NULL, fc_threshold = NULL, hilight = "none", hilight_alpha = .3, pie = "equal", split = NULL, includeAll = TRUE, ... ) { category_size_quo <- rlang::enquo(categorySizeBy) d <- tidy_compareCluster( x, showCategory = showCategory, split = split, includeAll = includeAll ) y <- split(d$geneID, d$Description) gs <- lapply(y, function(item) unique(unlist(strsplit(item, split = "/")))) category_size <- compute_comparecluster_category_size(d, category_size_quo) p <- cnetplot( gs, layout = layout, showCategory = names(gs), foldChange = foldChange, fc_threshold = fc_threshold, color_category = color_category, size_category = 0, color_item = color_item, size_item = 0, color_edge = color_edge, size_edge = size_edge, node_label = "none", hilight = hilight, hilight_alpha = hilight_alpha, ... ) p <- add_node_pie( p, d, pie, category_scale = size_category, item_scale = size_item, category_size = category_size ) p <- p + geom_cnet_label(node_label = node_label) return(p) } #' @importFrom ggplot2 coord_fixed add_node_pie <- function( p, d, pie = "equal", category_scale = 1, item_scale = 1, category_size = NULL ) { ## category nodes dd <- d[, c('Cluster', 'Description', 'Count')] default_size <- sapply(split(dd$Count, dd$Description), sum) if (is.null(category_size)) { category_size <- default_size } else { category_size <- category_size[names(default_size)] } if (pie == "equal") { dd$Count <- 1 } dd <- tidyr::pivot_wider( dd, names_from = "Cluster", values_from = "Count", values_fill = 0 ) normalized_category_size <- normalize_comparecluster_radius(category_size) dd$pathway_radius <- normalized_category_size[dd$Description] * category_scale ## gene nodes y <- split(d$geneID, d$Cluster) gs <- lapply(y, function(item) unique(unlist(strsplit(item, split = "/")))) dg <- yulab.utils::ls2df(gs) |> setNames(c("Cluster", "Description")) # second column is geneID dg$Count <- 1 dg <- tidyr::pivot_wider( dg, names_from = "Cluster", values_from = "Count", values_fill = 0 ) dg$pathway_radius <- .05 * item_scale d2 <- rbind(dd, dg) p <- p %<+% d2 + scatterpie::geom_scatterpie( aes( x = .data$x, y = .data$y, r = .data$pathway_radius ), cols = as.character(unique(d$Cluster)), legend_name = "Cluster", color = NA ) + coord_fixed() + guides(size = "none") if (any(dd$pathway_radius > 0)) { p <- p + scatterpie::geom_scatterpie_legend( unique(dd$pathway_radius), x = min(p$data$x), y = min(p$data$y), n = 3, labeller = function(x) { format(signif(x / category_scale * sum(category_size), 3), trim = TRUE) } ) } return(p) } compute_comparecluster_category_size <- function(d, categorySizeBy) { term_names <- unique(as.character(d$Description)) gene_sets <- split(d$geneID, d$Description) item_num <- vapply( gene_sets[term_names], function(item) { length(unique(unlist(strsplit(item, split = "/")))) }, FUN.VALUE = numeric(1) ) term_df <- data.frame( Description = term_names, itemNum = item_num, Count = vapply( split(d$Count, d$Description)[term_names], sum, FUN.VALUE = numeric(1) ), stringsAsFactors = FALSE ) numeric_cols <- setdiff(names(d)[vapply(d, is.numeric, logical(1))], "Count") if (length(numeric_cols) > 0) { for (col in numeric_cols) { term_df[[col]] <- summarize_comparecluster_numeric_column( d[[col]], d$Description, term_names, col ) } } if (inherits(categorySizeBy, "quosure")) { category_size_expr <- rlang::quo_get_expr(categorySizeBy) category_size_env <- rlang::quo_get_env(categorySizeBy) } else { category_size_expr <- substitute(categorySizeBy) category_size_env <- parent.frame() } if (rlang::is_formula(category_size_expr)) { category_size_expr <- rlang::f_rhs(category_size_expr) } category_size <- rlang::eval_tidy( rlang::new_quosure(category_size_expr, env = category_size_env), data = term_df ) if (!is.numeric(category_size)) { stop("`categorySizeBy` must evaluate to a numeric vector.") } if (length(category_size) == 1) { category_size <- rep(category_size, nrow(term_df)) } if (length(category_size) != nrow(term_df)) { stop("`categorySizeBy` must return a scalar or one value per category.") } if (anyNA(category_size) || any(!is.finite(category_size))) { stop("`categorySizeBy` returned non-finite values.") } if (any(category_size < 0)) { stop("`categorySizeBy` must be non-negative for pie radius scaling.") } if (sum(category_size) <= 0) { stop("`categorySizeBy` must produce at least one positive value.") } stats::setNames(category_size, term_df$Description) } summarize_comparecluster_numeric_column <- function(values, groups, group_names, column_name) { split_values <- split(values, groups) vapply( split_values[group_names], function(x) { x <- x[is.finite(x)] if (length(x) == 0) { return(NA_real_) } if (column_name %in% c("pvalue", "p.adjust", "qvalue")) { return(min(x)) } unique_values <- unique(x) if (length(unique_values) == 1) { return(unique_values) } NA_real_ }, FUN.VALUE = numeric(1) ) } normalize_comparecluster_radius <- function(x) { total <- sum(x) if (!is.finite(total) || total <= 0) { stop("Category pie size scaling requires a positive total size.") } x / total } tidy_compareCluster <- function( x, showCategory, split = NULL, includeAll = TRUE ) { d <- fortify( x, showCategory = showCategory, includeAll = includeAll, split = split ) d$Cluster <- sub("\n.*", "", d$Cluster) if ("core_enrichment" %in% colnames(d)) { ## for GSEA result d$geneID <- d$core_enrichment } return(d) } ================================================ FILE: R/color_utils.R ================================================ #' Color utility functions for enrichplot package #' #' This file contains all color-related helper functions #' Get default enrichplot colors #' #' @param n number of colors (2 or 3) #' @return color vector #' @export get_enrichplot_color <- function(n = 2) { colors <- getOption("enrichplot.colours") if (!is.null(colors)) { return(colors) } if (n != 2 && n != 3) { rlang::abort("'n' should be 2 or 3", .arg = "n") } colors = c("#e06663", "#327eba") if (n == 2) { return(colors) } if (n == 3) return(c(colors[1], "white", colors[2])) } #' Helper function to set color scale for enrichplot #' #' @param colors user provided color vector #' @param type one of 'color', 'colour' or 'fill' #' @param name name of the color legend #' @param .fun force to use user provided color scale function #' @param reverse whether reverse the color scheme #' @param transform transform the color scale #' @param ... additional parameters #' @return a color scale #' @importFrom ggplot2 scale_fill_continuous #' @importFrom ggplot2 scale_color_continuous #' @importFrom ggplot2 scale_fill_gradientn #' @importFrom ggplot2 scale_color_gradientn #' @importFrom ggplot2 guide_colorbar #' @importFrom yulab.utils yulab_abort #' @importFrom yulab.utils yulab_warn #' @importFrom yulab.utils check_input #' @author Guangchuang Yu #' @export set_enrichplot_color <- function( colors = get_enrichplot_color(2), type = "color", name = NULL, .fun = NULL, reverse = TRUE, transform = 'identity', ... ) { type <- match.arg(type, c("color", "colour", "fill")) if (!reverse) { colors = rev(colors) } n <- length(colors) ## Input validation check_input(colors, type = "character", min_length = 2, arg_name = "colors") check_input(type, type = "character", arg_name = "type") if (n < 2) { yulab_abort("'colors' should be of length >= 2", class = "color_length_error") } else if (n == 2) { params <- list(low = colors[1], high = colors[2]) fn_suffix <- "continuous" } else if (n == 3) { params <- list(low = colors[1], mid = colors[2], high = colors[3]) fn_suffix <- "gradient2" } else { params <- list(colors = colors) fn_suffix <- "gradientn" } if (!is.null(.fun)) { if (n == 3) { fn_type <- which_scale_fun(.fun) if (fn_type == "gradientn") { params <- list(colors = colors) } else { params <- list( low = colors[1], mid = colors[2], high = colors[3] ) } } } else { fn <- sprintf("scale_%s_%s", type, fn_suffix) .fun <- getFromNamespace(fn, "ggplot2") } params$guide <- guide_colorbar(reverse = reverse, order = 1) params$name <- name params$transform <- transform params <- modifyList(params, list(...)) do.call(.fun, params) } #' Determine which scale function to use #' #' @param .fun function to check #' @return scale function type #' @noRd which_scale_fun <- function(.fun) { params <- args(.fun) |> as.list() |> names() if ("colours" %in% params) { return("gradientn") } if ("mid" %in% params) { return("gradient2") } return("continuous") } #' Create color palette for continuous data #' #' @param colors colors of length >=2 #' @return color vector #' @importFrom rlang check_installed #' @importFrom yulab.utils check_input #' @export #' @examples #' color_palette(c("red", "yellow", "green")) #' @author guangchuang yu color_palette <- function(colors) { ## Check input validity yulab.utils::check_input(colors, type = "character", min_length = 2, arg_name = "colors") rlang::check_installed('grDevices', 'for `color_palette()`.') grDevices::colorRampPalette(colors)(n = 299) } #' Predefined color palettes enrichplot_point_shape <- ggfun:::enrichplot_point_shape sig_palette <- color_palette(c("red", "yellow", "blue")) heatmap_palette <- color_palette(c("red", "yellow", "green")) ================================================ FILE: R/data_utils.R ================================================ #' Data processing utility functions for enrichplot package #' #' This file contains data manipulation and processing helper functions #' Update showCategory parameter #' #' @param x input object #' @param showCategory category specification #' @return updated category specification #' @noRd update_n <- function(x, showCategory) { ## Input validation check_input(x, arg_name = "x") check_input(showCategory, arg_name = "showCategory") if (!is.numeric(showCategory)) { if (inherits(x, 'list')) { showCategory <- showCategory[showCategory %in% names(x)] } else { if (!"Description" %in% colnames(as.data.frame(x))) { yulab_abort( "Input data must have 'Description' column", class = "missing_column_error" ) } showCategory <- intersect(showCategory, x$Description) } return(showCategory) } n <- showCategory if (inherits(x, 'list')) { nn <- length(x) } else { nn <- nrow(x) } if (nn < n) { yulab_warn( paste0( "showCategory (", n, ") is larger than available items (", nn, "). Using ", nn ), class = "showCategory_warning" ) n <- nn } return(n) } #' Extract gene sets from enrichment result #' #' @param x enrichment result object #' @param n number of categories or specific categories #' @return gene sets list #' @noRd extract_geneSets <- function(x, n) { n <- update_n(x, n) if (inherits(x, 'list')) { geneSets <- x } else { geneSets <- geneInCategory(x) ## use core gene for gsea result y <- as.data.frame(x) geneSets <- geneSets[y$ID] names(geneSets) <- y$Description } if (is.numeric(n)) { return(geneSets[1:n]) } return(geneSets[n]) ## if n is a vector of Description } #' Make fold change data readable #' #' @param x enrichment result object #' @param foldChange fold change vector #' @return readable fold change vector #' @noRd fc_readable <- function(x, foldChange = NULL) { if (is.null(foldChange)) { return(NULL) } if (x@readable && x@keytype != "SYMBOL") { gid <- names(foldChange) if (is(x, 'gseaResult')) { ii <- gid %in% names(x@geneList) } else { ii <- gid %in% x@gene } gid[ii] <- x@gene2Symbol[gid[ii]] names(foldChange) <- gid } return(foldChange) } #' Calculate overlap ratio between two gene sets #' #' @param x first gene set #' @param y second gene set #' @return Jaccard similarity coefficient #' @noRd overlap_ratio <- function(x, y) { x <- unique(unlist(x)) y <- unique(unlist(y)) length(intersect(x, y)) / length(union(x, y)) } #' Calculate Jaccard similarity matrix #' #' @param gsetlist list of gene sets #' @param id gene set IDs #' @param name gene set names #' @return similarity matrix #' @noRd .cal_jc_similarity <- function(gsetlist, id = NULL, name = NULL) { if (is.null(id)) { id <- names(gsetlist) } n <- length(id) w <- matrix(NA, nrow = n, ncol = n) if (is.null(name)) { name <- id } colnames(w) <- rownames(w) <- name # Vectorized computation: precompute all gene sets gsets <- lapply(gsetlist[id], unique) # Use outer function for vectorized computation jc_matrix <- outer(seq_len(n), seq_len(n), Vectorize(function(i, j) { if (i == j) { return(1) } overlap_ratio(gsets[[i]], gsets[[j]]) })) # Ensure symmetry jc_matrix[lower.tri(jc_matrix)] <- t(jc_matrix)[lower.tri(t(jc_matrix))] colnames(jc_matrix) <- rownames(jc_matrix) <- name return(jc_matrix) } #' Prepare pie data for genes in cnetplot (compareClusterResult only) #' #' @param y data frame from compareClusterResult #' @return pie data #' @importFrom rlang check_installed #' @noRd prepare_pie_gene <- function(y) { ## Input validation check_input(y, type = "data.frame", arg_name = "y") check_installed('tibble', 'for `prepare_pie_gene()`.') gene_pie <- tibble::as_tibble(y[, c("Cluster", "Description", "geneID")]) gene_pie$geneID <- strsplit(gene_pie$geneID, '/') gene_pie2 <- as.data.frame(tidyr::unnest(gene_pie, cols = geneID)) gene_pie2 <- unique(gene_pie2) prepare_pie_data(gene_pie2, pie = "equal", type = "gene") } #' Prepare pie data for categories in cnetplot/emapplot #' #' @param enrichDf enrichment data frame #' @param pie proportion type (equal, count, Count) #' @return pie data matrix #' @noRd prepare_pie_category <- function(enrichDf, pie = "equal") { pie <- match.arg(pie, c("equal", "count", "Count")) if (pie == "count") { pie <- "Count" } pie_data <- enrichDf[, c("Cluster", "Description", "Count")] pie_data[, "Description"] <- as.character(pie_data[, "Description"]) prepare_pie_data(pie_data, pie = pie) } #' Prepare pie data matrix #' #' @param pie_data input data #' @param pie proportion type #' @param type gene or category #' @return pie data matrix #' @noRd prepare_pie_data <- function(pie_data, pie = "equal", type = "category") { if (type == "category") { ID_unique <- unique(pie_data[, 2]) } else { ID_unique <- unique(pie_data[, 3]) } Cluster_unique <- unique(pie_data[, 1]) ID_Cluster_mat <- matrix( 0, nrow = length(ID_unique), ncol = length(Cluster_unique) ) rownames(ID_Cluster_mat) <- ID_unique colnames(ID_Cluster_mat) <- Cluster_unique ID_Cluster_mat <- as.data.frame(ID_Cluster_mat, stringAsFactors = FALSE) if (pie == "Count") { # Vectorized matrix indexing idx <- cbind( match(pie_data[, 2], rownames(ID_Cluster_mat)), match(pie_data[, 1], colnames(ID_Cluster_mat)) ) ID_Cluster_mat[idx] <- pie_data[, 3] # Convert all columns to numeric at once ID_Cluster_mat[] <- lapply(ID_Cluster_mat, as.numeric) return(ID_Cluster_mat) } # Vectorized matrix indexing for equal pie if (type == "category") { idx <- cbind( match(pie_data[, 2], rownames(ID_Cluster_mat)), match(pie_data[, 1], colnames(ID_Cluster_mat)) ) } else { idx <- cbind( match(pie_data[, 3], rownames(ID_Cluster_mat)), match(pie_data[, 1], colnames(ID_Cluster_mat)) ) } ID_Cluster_mat[idx] <- 1 return(ID_Cluster_mat) } #' Convert compareClusterResult to data frame #' #' @param x compareClusterResult object #' @param ... additional parameters #' @return data frame #' @export #' @method as.data.frame compareClusterResult as.data.frame.compareClusterResult <- function(x, ...) { as.data.frame(x@compareClusterResult, ...) } ================================================ FILE: R/densityplot.R ================================================ #' plot logFC distribution of selected gene sets #' #' #' @title gseadist #' @param x GSEA result #' @param IDs gene set IDs #' @param type one of 'density' or 'boxplot' #' @return distribution plot #' @importFrom ggplot2 geom_density #' @importFrom ggplot2 geom_boxplot #' @export #' @author Guangchuang Yu gseadist <- function(x, IDs, type = 'density') { d <- data.frame(gene = names(x@geneList), logFC = x@geneList, category = 'All Genes') ds <- do.call('rbind', lapply(IDs, function(i) { if (!is.numeric(i)) { i <- match(i, x$ID) if (is.na(i)) i <- match(i, x$Description) } id <- x$ID[i] gene <- x@geneSets[[id]] gs <- x@geneList[gene] gs <- gs[!is.na(gs)] data.frame(gene = names(gs), logFC = gs, category = x$Description[i]) })) dd <- rbind(d, ds) p <- ggplot(dd) + theme_minimal() if (type == 'density') { p <- p + geom_density(aes(x = .data$logFC, color = .data$category)) + ## geom_rug(data = ds, show.legend = FALSE) + ylab(NULL) + theme(legend.title = element_blank(), legend.position = 'bottom') } else if (type == 'boxplot') { p <- p + geom_boxplot(aes(x = .data$category, y = .data$logFC, fill = .data$category)) + xlab(NULL) + theme(legend.position = 'none') } return(p) } ================================================ FILE: R/dotplot.R ================================================ #' @rdname dotplot #' @exportMethod dotplot #' @author Guangchuang Yu setMethod( "dotplot", signature(object = "enrichResult"), function( object, x = "GeneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, ... ) { dotplot.enrichResult( object = object, x = x, color = color, showCategory = showCategory, size = size, split = split, font.size = font.size, title = title, orderBy = orderBy, label_format = label_format, ... ) } ) #' @rdname dotplot #' @exportMethod dotplot setMethod( "dotplot", signature(object = "gseaResult"), function( object, x = "GeneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, ... ) { if (color == "NES") { NES <- TRUE color <- "p.adjust" } else { NES <- FALSE } p <- dotplot.enrichResult( object = object, x = x, color = color, showCategory = showCategory, size = size, split = split, font.size = font.size, title = title, orderBy = orderBy, label_format = label_format, ... ) if (NES) { p <- suppressMessages( p + aes(fill = .data$NES) + set_enrichplot_color( type = "fill", name = "NES" ) ) } return(p) } ) #' @rdname dotplot #' @aliases dotplot,compareClusterResult,ANY-method #' @exportMethod dotplot setMethod( "dotplot", signature(object = "compareClusterResult"), function( object, x = "Cluster", color = "p.adjust", showCategory = 5, split = NULL, font.size = 12, title = "", by = "geneRatio", size = NULL, includeAll = TRUE, label_format = 30, ... ) { dotplot.compareClusterResult( object, x = x, colorBy = color, showCategory = showCategory, by = by, size = size, includeAll = includeAll, split = split, font.size = font.size, title = title, label_format = label_format, ... ) } ) #' @rdname dotplot #' @exportMethod dotplot #' @aliases dotplot,enrichResultList,ANY-method #' @author Guangchuang Yu setMethod( "dotplot", signature(object = "enrichResultList"), function( object, x = "GeneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, ... ) { dotplot.enrichResult( object = object, x = x, color = color, showCategory = showCategory, size = size, split = split, font.size = font.size, title = title, orderBy = orderBy, label_format = label_format, ... ) } ) #' @rdname dotplot #' @exportMethod dotplot #' @aliases dotplot,gseaResultList,ANY-method setMethod( "dotplot", signature(object = "gseaResultList"), function( object, x = "GeneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, ... ) { if (color == "NES") { NES <- TRUE color <- "p.adjust" } else { NES <- FALSE } p <- dotplot.enrichResult( object = object, x = x, color = color, showCategory = showCategory, size = size, split = split, font.size = font.size, title = title, orderBy = orderBy, label_format = label_format, ... ) if (NES) { p <- suppressMessages( p + aes(fill = .data$NES) + set_enrichplot_color(type = "fill", name = "NES") ) } return(p) } ) #' @rdname dotplot #' @param x variable for x-axis, one of 'GeneRatio' and 'Count' #' @param color variable used to color enriched terms, #' e.g. 'pvalue', 'p.adjust' or 'qvalue' #' @param showCategory number of categories to display or a vector of terms. #' @param size variable used to scale the sizes of categories, #' one of "geneRatio", "Percentage" and "count" #' @param split separate result by 'category' variable #' @param font.size font size #' @param title plot title #' @param label_format a numeric value sets wrap length, alternatively a #' custom function to format axis labels. #' by default wraps names longer than 30 characters #' @param orderBy The order of the Y-axis #' @param decreasing logical. Should the orderBy order be increasing or decreasing? #' @importFrom ggplot2 fortify #' @importFrom ggplot2 ggplot #' @importFrom ggplot2 aes #' @importFrom ggplot2 geom_point #' @importFrom ggplot2 scale_color_gradient #' @importFrom ggplot2 scale_color_continuous #' @importFrom ggplot2 xlab #' @importFrom ggplot2 ylab #' @importFrom ggplot2 labs #' @importFrom ggplot2 ggtitle #' @importFrom ggplot2 scale_y_discrete #' @importFrom ggplot2 guides #' @importFrom ggplot2 guide_legend #' @importFrom methods is dotplot.enrichResult <- function( object, x = "geneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, decreasing = TRUE ) { colorBy <- match.arg(color, c("pvalue", "p.adjust", "qvalue")) .formula_expr <- NULL .orig_x <- x if (x == "geneRatio" || x == "GeneRatio") { x <- "GeneRatio" if (is.null(size)) { size <- "Count" } } else if (x == "count" || x == "Count") { x <- "Count" if (is.null(size)) { size <- "GeneRatio" } } else if (is(x, "formula")) { .formula_expr <- rlang::f_rhs(x) x <- "x" if (is.null(size)) { size <- "Count" } } else { ## message("invalid x, setting to 'GeneRatio' by default") ## x <- "GeneRatio" ## size <- "Count" if (is.null(size)) { size <- "Count" } } if (inherits(object, c("enrichResultList", "gseaResultList"))) { ldf <- lapply( object, fortify, showCategory = showCategory, split = split ) df <- dplyr::bind_rows(ldf, .id = "category") df$category <- factor(df$category, levels = names(object)) } else { df <- fortify(object, showCategory = showCategory, split = split) ## already parsed in fortify ## df$GeneRatio <- parse_ratio(df$GeneRatio) } if (!is.null(.formula_expr)) { df$x <- rlang::eval_tidy(.formula_expr, data = df) } if (orderBy != 'x' && !orderBy %in% colnames(df)) { message('wrong orderBy parameter; set to default `orderBy = "x"`') orderBy <- "x" } if (orderBy == "x") { df <- dplyr::mutate(df, x = .data[[x]]) } label_func <- .label_format(label_format) idx <- order(df[[orderBy]], decreasing = decreasing) df$Description <- factor( df$Description, levels = rev(unique(df$Description[idx])) ) # Use internal helper function for common plotting logic p <- .dotplot_internal( df = df, x = x, size = size, colorBy = colorBy, color = color, label_func = label_func, font.size = font.size, title = title ) return(p) } .label_format <- function(label_format = 30) { label_func <- default_labeller(label_format) if (is.function(label_format)) { label_func <- label_format } return(label_func) } #' Internal helper function for dotplot construction #' @param df data frame containing the plot data #' @param x x-axis variable name #' @param size size variable name #' @param colorBy color variable name #' @param color color parameter name for legend #' @param label_func function for formatting labels #' @param font.size font size for theme #' @param title plot title #' @param size_range range for size scaling, default c(3, 8) #' @param shape_point whether to use enrichplot_point_shape, default TRUE #' @return ggplot object with enrichplotDot class #' @noRd .dotplot_internal <- function(df, x, size, colorBy, color, label_func, font.size, title, size_range = c(3, 8), shape_point = TRUE) { p <- ggplot( df, aes( x = .data[[x]], y = .data[["Description"]], size = .data[[size]], fill = .data[[colorBy]] ) ) + geom_point() + set_enrichplot_color(type = "fill", name = color, transform = 'log10') + scale_y_discrete(labels = label_func) + ylab(NULL) + ggtitle(title) + theme_dose(font.size) if (shape_point) { p <- p + aes(shape = I(enrichplot_point_shape)) } # Apply size scaling if (size == "Count") { # For Count, use pretty breaks size_break <- pretty(df[[size]], n = 4) p <- p + scale_size(range = size_range, breaks = size_break) } else { p <- p + scale_size(range = size_range) } class(p) <- c("enrichplotDot", class(p)) return(p) } #' @rdname dotplot #' @param object compareClusterResult object #' @param by one of "geneRatio", "Percentage" and "count" #' @param split apply `showCategory` to each category specified by the 'split', e.g., "ONTOLOGY", "category" and "intersect". Default is NULL and do nothing #' @param includeAll logical value #' @param font.size font size #' @param title figure title #' @param group a logical value, whether to connect the #' nodes of the same group with wires. #' @param shape a logical value, whether to use nodes of #' different shapes to distinguish the group it belongs to #' @param facet apply `facet_grid` to the plot by specified variable, e.g., "ONTOLOGY", "category" and "intersect". #' @param strip_width width of strip text (facet label). #' @param colorBy variable used to color enriched terms, #' e.g. 'pvalue', 'p.adjust' or 'qvalue' #' @importFrom ggplot2 facet_grid #' @importFrom ggplot2 scale_size_continuous #' @importFrom rlang check_installed dotplot.compareClusterResult <- function( object, x = "Cluster", colorBy = "p.adjust", showCategory = 5, by = "geneRatio", size = "geneRatio", split = NULL, includeAll = TRUE, font.size = 12, title = "", label_format = 30, group = FALSE, shape = FALSE, facet = NULL, strip_width = 15 ) { color <- NULL if (is.null(size)) { size <- by } ## by may deprecated in future release if (!is.null(facet) && facet == "intersect") { object <- append_intersect(object) } df <- fortify( object, showCategory = showCategory, by = size, includeAll = includeAll, split = split ) # if (by != "geneRatio") # df$GeneRatio <- parse_ratio(df$GeneRatio) label_func <- default_labeller(label_format) if (is.function(label_format)) { label_func <- label_format } if (size %in% c("rowPercentage", "count", "geneRatio")) { by2 <- switch( size, rowPercentage = "Percentage", count = "Count", geneRatio = "GeneRatio" ) } else { by2 <- size } # Use internal helper function for base plot, but without shape_point for flexibility p <- .dotplot_internal( df = df, x = x, size = by2, colorBy = colorBy, color = colorBy, label_func = label_func, font.size = font.size, title = title, shape_point = FALSE # We'll handle shape manually ) # Add group connections if requested if (group) { p <- p + geom_line( aes(color = .data$Cluster, group = .data$Cluster), size = .3 ) + ggnewscale::new_scale_colour() } # Handle shape variations if (shape) { check_installed('ggstar', 'for `dotplot()` with `shape = TRUE`.') ggstar <- "ggstar" require(ggstar, character.only = TRUE) # Replace the base geom_point with ggstar p$layers <- p$layers[-1] # Remove the first geom_point layer p <- p + ggstar::geom_star(aes( starshape = .data$Cluster, fill = .data[[colorBy]] )) + set_enrichplot_color(type = "fill", transform = 'log10') } else { # Add standard point with shape p <- p + aes(shape = I(enrichplot_point_shape)) } # Add facet if requested if (!is.null(facet)) { p <- p + facet_grid( .data[[facet]] ~ ., scales = "free", space = 'free', switch = 'y', labeller = ggplot2::label_wrap_gen(strip_width) ) + theme(strip.text = element_text(size = 14)) } return(p) } append_intersect <- function(x) { if (!inherits(x, 'compareClusterResult')) { stop("x should be a compareClusterResult object") } d <- as.data.frame(x) so <- vapply( split(d$Cluster, d$Description), FUN = paste, FUN.VALUE = character(1), collapse = " & " ) set_info <- data.frame( intersect = so, Description = names(so) ) d2 <- merge(d, set_info, by = "Description") n <- levels(d2$Cluster) cc <- yulab.utils::combinations(length(n)) lv <- vapply(cc, function(i) paste(n[i], collapse = " & "), character(1)) d2$intersect <- factor(d2$intersect, levels = lv) x@compareClusterResult <- d2 return(x) } #' compare two clusters in the compareClusterResult object #' #' #' @title dotplot2 #' @param object a compareClusterResult object #' @param x selected variable to visualize in x-axis #' @param vars selected Clusters to be compared, only length of two is supported #' @param label to label the Clusters in the plot, should be a named vector #' @param ... additional parameters passed to dotplot #' @return a ggplot object #' @importFrom ggplot2 geom_segment #' @importFrom ggplot2 geom_vline #' @importFrom ggplot2 geom_blank #' @importFrom grid arrow #' @importFrom grid unit #' @importFrom ggplot2 geom_text #' @export #' @author Guangchuang Yu dotplot2 <- function( object, x = "FoldEnrichment", vars = NULL, label = "auto", ... ) { if (!is(object, 'compareClusterResult')) { stop('only compareClusterResult object is supported') } if (length(vars) != 2) { stop("vars should be of length 2.") } object <- dplyr::filter(object, .data$Cluster %in% vars) d <- object@compareClusterResult d[[x]] <- d[[x]] * ifelse(d$Cluster == vars[1], -1, 1) object@compareClusterResult <- d p <- dotplot(object, x = x, ...) p <- p + geom_segment( aes(xend = 0, yend = .data$Description), size = 1, color = 'grey50' ) + geom_vline(xintercept = 0, lty = 'dashed') + scale_x_continuous(labels = abs) p$layers <- rev(p$layers) if (is.null(label)) { return(p) } d <- dplyr::group_by(object, .data$Cluster) |> dplyr::summarise(mid = max(abs(.data[[x]])) * sign(max(.data[[x]])) / 2) if (label != "auto") { d$Cluster <- label[d$Cluster] } p + geom_text( aes(x = .data$mid, y = .4, label = .data$Cluster), data = d, inherit.aes = FALSE, size = 5 ) + geom_segment( aes(x = 0, xend = .data$mid, y = .2, yend = .2), data = d, inherit.aes = FALSE, arrow = arrow(length = unit(0.30, "cm"), type = "closed") ) + geom_blank( data = data.frame(y = 0), aes(y = .data$y), inherit.aes = FALSE ) } ================================================ FILE: R/emapplot.R ================================================ #' @rdname emapplot #' @exportMethod emapplot setMethod( "emapplot", signature(x = "enrichResult"), function(x, showCategory = 30, ...) { emapplot_internal(x, showCategory = showCategory, ...) } ) #' @rdname emapplot #' @exportMethod emapplot setMethod( "emapplot", signature(x = "gseaResult"), function(x, showCategory = 30, ...) { emapplot_internal(x, showCategory = showCategory, ...) } ) #' @rdname emapplot #' @exportMethod emapplot setMethod( "emapplot", signature(x = "compareClusterResult"), function(x, showCategory = 30, ...) { emapplot_internal(x, showCategory = showCategory, ...) } ) #' @rdname emapplot #' @param layout igraph layout #' @param color Variable used to color enriched terms, e.g. 'pvalue', #' 'p.adjust' or 'qvalue'. #' @param size_category relative size of the categories #' @param min_edge The minimum similarity threshold for whether #' two nodes are connected, should be between 0 and 1, default value is 0.2. #' @param color_edge color of the network edge #' @param size_edge relative size of edge width #' @param node_label Select which labels to display, #' one of 'category', 'group', 'all' and 'none'. #' @param node_label_size size of node label, default is 5. #' @param pie one of 'equal' or 'Count' to set the slice ratio of the pies # @param group logical, if TRUE, group the category. # @param group_style style of ellipse, one of "ggforce" an "polygon". # @param label_group_style style of group label, one of "shadowtext" and "ggforce". #' @param label_format a numeric value sets wrap length, alternatively a custom function to format axis labels. #' @param clusterFunction clustering method function, such as `stats::kmeans` (default), #' `cluster::clara`, `cluster::fanny`, or `cluster::pam`. #' @param nWords Numeric, the number of words in the cluster tags, the default value is 4. #' @param nCluster Numeric, the number of clusters, #' the default value is square root of the number of nodes. #' @importFrom ggplot2 scale_size #' @importFrom ggtangle geom_edge #' @importFrom ggrepel geom_text_repel #' @importFrom ggrepel geom_label_repel #' @author Guangchuang Yu emapplot_internal <- function( x, layout = igraph::layout_with_kk, showCategory = 30, color = "p.adjust", size_category = 1, min_edge = .2, color_edge = "grey", size_edge = .5, node_label = "category", node_label_size = 5, pie = "equal", label_format = 30, clusterFunction = stats::kmeans, nWords = 4, nCluster = NULL ) { if (inherits(x, 'compareClusterResult')) { gg <- graph_from_compareClusterResult( x, showCategory = showCategory, color = color, min_edge = min_edge, size_edge = size_edge ) } else { gg <- graph_from_enrichResult( x, showCategory = showCategory, color = color, min_edge = min_edge, size_edge = size_edge ) } g <- gg$graph size <- vapply(gg$geneSet, length, FUN.VALUE = numeric(1)) V(g)$size = size[V(g)$name] p <- ggplot(g, layout = layout) + geom_edge(color = color_edge, linewidth = size_edge) if (inherits(x, 'compareClusterResult')) { p <- add_node_pie(p, gg$data, pie, category_scale = size_category) } else { if (color %in% names(as.data.frame(x))) { p <- p %<+% x[, c("Description", color)] + geom_point(aes(color = .data[[color]], size = .data$size)) + scale_size(range = c(3, 8) * size_category) p <- p + set_enrichplot_color(colors = get_enrichplot_color(2)) p <- p + guides( size = guide_legend(order = 1), color = guide_colorbar(order = 2, reverse = TRUE) ) } else { p <- p %<+% x[, "Description", drop = FALSE] + geom_point(aes(size = .data$size), color = color) + scale_size(range = c(3, 8) * size_category) } } group <- group_label <- FALSE if (node_label == "group") { group <- TRUE } if (node_label == "all") { group <- TRUE group_label <- TRUE node_label <- "category" } if (group) { if (inherits(x, 'compareClusterResult')) { p <- p + ggnewscale::new_scale_fill() } #else { # p <- p + ggnewscale::new_scale_color() #} node_data <- groupNode( p@data, as.data.frame(x), nWords, clusterFunction = clusterFunction, nCluster = nCluster ) p <- p + add_ellipse( node_data, group_legend = TRUE, label = group_label ) } ## add node label if (node_label == "category") { p <- p + geom_text_repel( aes(label = .data$label), bg.color = "white", bg.r = .1, size = node_label_size ) } ## add group label if (node_label == "group") { label_location <- get_label_location( node_data = node_data, label_format = label_format ) p <- p + geom_text_repel( aes(x = .data$x, y = .data$y, label = .data$label), data = label_location, bg.color = "white", bg.r = .1, size = node_label_size ) } p + coord_equal() + guides( size = guide_legend(order = 1), color = guide_colorbar(order = 2) ) } graph_from_enrichResult <- function( x, showCategory = 30, color = "p.adjust", min_edge = .2, size_edge = .5 ) { n <- update_n(x, showCategory) y <- as.data.frame(x) ## get graph.data.frame() object g <- get_igraph( x = x, nCategory = n, color = color, cex_line = size_edge, min_edge = min_edge ) gs <- extract_geneSets(x, n) return(list(graph = g, geneSet = gs)) } graph_from_compareClusterResult <- function( x, showCategory = 30, color = "p.adjust", min_edge = .2, size_edge = .5 ) { d <- tidy_compareCluster(x, showCategory) mergedEnrichDf <- merge_compareClusterResult(d) gs <- setNames( strsplit(as.character(mergedEnrichDf$geneID), "/", fixed = TRUE), mergedEnrichDf$ID ) g <- build_emap_graph( enrichDf = mergedEnrichDf, geneSets = gs, color = color, cex_line = size_edge, min_edge = min_edge, pair_sim = x@termsim, method = x@method ) return(list(graph = g, geneSet = gs, data = d)) } ================================================ FILE: R/emapplot_utilities.R ================================================ #' Get the similarity matrix #' #' @param y A data.frame of enrichment result #' @param geneSets A list, the names of geneSets are term ids, #' and every element is a vector of genes. #' @param method Method of calculating the similarity between nodes, #' one of "Resnik", "Lin", "Rel", "Jiang" , "Wang" and #' "JC" (Jaccard similarity coefficient) methods #' @param semData GOSemSimDATA object #' @noRd get_similarity_matrix <- function(y, geneSets, method, semData = NULL) { id <- y[, "ID"] geneSets <- geneSets[id] y_id <- unlist(strsplit(y$ID[1], ":"))[1] ## Choose the method to calculate the similarity if (method == "JC") { w <- .cal_jc_similarity(geneSets, id = id, name = y$Description) return(w) } if (y_id == "GO") { if (is.null(semData)) { stop( "The semData parameter is missing, and it can be obtained through godata function in GOSemSim package." ) } w <- GOSemSim::mgoSim( id, id, semData = semData, measure = method, combine = NULL ) } if (y_id == "DOID") { w <- DOSE::doSim(id, id, measure = method) } rownames(y) <- y$ID rownames(w) <- colnames(w) <- y[colnames(w), "Description"] return(w) } #' Check whether the similarity matrix exists #' #' @param x result of enrichment analysis #' #' @noRd has_pairsim <- function(x) { if (length(x@termsim) == 0) { error_message <- paste( "Term similarity matrix not available.", "Please use pairwise_termsim function to", "deal with the results of enrichment analysis." ) stop(error_message) } } #' Get graph_from_data_frame() result #' #' @importFrom igraph graph.empty #' @importFrom igraph graph_from_data_frame #' @param enrichDf A data.frame of enrichment result. #' @param geneSets A list gene sets with the names of enrichment IDs #' @param color a string, the column name of y for nodes colours #' @param cex_line Numeric, scale of line width #' @param min_edge The minimum similarity threshold for whether #' two nodes are connected; should be between 0 and 1 (default `0.2`). #' @param pair_sim Semantic similarity matrix. #' @param method Method of calculating the similarity between nodes, #' one of "Resnik", "Lin", "Rel", "Jiang" , "Wang" and #' "JC" (Jaccard similarity coefficient) methods #' @return result of graph_from_data_frame() #' @importFrom igraph V #' @importFrom igraph 'V<-' #' @importFrom igraph E #' @importFrom igraph 'E<-' #' @importFrom igraph add_vertices #' @importFrom igraph delete.edges #' @noRd build_emap_graph <- function( enrichDf, geneSets, color, cex_line, min_edge, pair_sim, method ) { if (!is.numeric(min_edge) || min_edge < 0 || min_edge > 1) { stop('"min_edge" should be a number between 0 and 1.') } if (is.null(dim(enrichDf)) || nrow(enrichDf) == 1) { # when just one node g <- graph.empty(0, directed = FALSE) g <- add_vertices(g, nv = 1) V(g)$name <- as.character(enrichDf$Description) V(g)$color <- "red" return(g) } else { w <- pair_sim[ as.character(enrichDf$Description), as.character(enrichDf$Description) ] } wd <- reshape2::melt(w) wd <- wd[wd[, 1] != wd[, 2], ] # remove NA wd <- wd[!is.na(wd[, 3]), ] if (method != "JC") { # map id to names wd[, 1] <- enrichDf[wd[, 1], "Description"] wd[, 2] <- enrichDf[wd[, 2], "Description"] } g <- graph_from_data_frame(wd[, -3], directed = FALSE) E(g)$width <- sqrt(wd[, 3] * 5) * cex_line # Use similarity as the weight(length) of an edge E(g)$weight <- wd[, 3] g <- delete.edges(g, E(g)[wd[, 3] < min_edge]) idx <- unlist(sapply(V(g)$name, function(x) { which(x == enrichDf$Description) })) cnt <- sapply(geneSets[idx], length) V(g)$size <- cnt if (color %in% names(enrichDf)) { colVar <- enrichDf[idx, color] } else { colVar <- color } V(g)$color <- colVar return(g) } #' Get an iGraph object #' #' @param x Enrichment result. #' @param nCategory Number of enriched terms to display. #' @param color variable that used to color enriched terms, e.g. 'pvalue', #' 'p.adjust' or 'qvalue'. #' @param cex_line Scale of line width. #' @param min_edge The minimum similarity threshold for whether #' two nodes are connected, should between 0 and 1, default value is 0.2. #' #' @return an iGraph object #' @noRd get_igraph <- function(x, nCategory, color, cex_line, min_edge) { y <- as.data.frame(x) geneSets <- geneInCategory(x) ## use core gene for gsea result if (is.numeric(nCategory)) { y <- y[1:nCategory, ] } else { y <- y[match(nCategory, y$Description), ] nCategory <- length(nCategory) } if (nCategory == 0) { stop("no enriched term found...") } build_emap_graph( enrichDf = y, geneSets = geneSets, color = color, cex_line = cex_line, min_edge = min_edge, pair_sim = x@termsim, method = x@method ) } #' Merge the compareClusterResult file #' #' @param yy A data.frame of enrichment result. #' #' @return a data.frame #' @noRd merge_compareClusterResult <- function(yy) { yy_union <- yy[!duplicated(yy$ID), ] yy_ids <- lapply(split(yy, yy$ID), function(x) { ids <- unique(unlist(strsplit(x$geneID, "/"))) cnt <- length(ids) list(ID = paste0(ids, collapse = "/"), cnt = cnt) }) ids <- vapply(yy_ids, function(x) x$ID, character(1)) cnt <- vapply(yy_ids, function(x) x$cnt, numeric(1)) yy_union$geneID <- ids[yy_union$ID] yy_union$Count <- cnt[yy_union$ID] yy_union$Cluster <- NULL yy_union } #' Get the location of group label #' #' @param node_data node information data frame #' @param label_format A numeric value sets wrap length, alternatively a #' custom function to format axis labels. #' @return a data.frame object. #' @noRd get_label_location <- function(node_data, label_format) { label_func <- default_labeller(label_format) if (is.function(label_format)) { label_func <- label_format } label_x <- stats::aggregate(x ~ color2, node_data, mean) label_y <- stats::aggregate(y ~ color2, node_data, mean) data.frame(x = label_x$x, y = label_y$y, label = label_func(label_x$color2)) } #' Cluster similar nodes together by k-means #' #' @param node_data node information data frame. #' @param enrichDf data.frame of enrichment result. #' @param nWords Numeric, the number of words in the cluster tags. #' @param clusterFunction clustering method function, such as `stats::kmeans`, `cluster::clara`, #' `cluster::fanny`, or `cluster::pam`. #' @param nCluster Numeric, the number of clusters, #' the default value is square root of the number of nodes. #' @noRd groupNode <- function( node_data, enrichDf, nWords, clusterFunction = stats::kmeans, nCluster ) { wrongMessage <- paste( "Wrong clusterFunction parameter or unsupported clustering method;", "set to default `clusterFunction = kmeans`" ) if (is.character(clusterFunction)) { clusterFunction <- eval(parse(text = clusterFunction)) } if (!"color2" %in% colnames(node_data)) { dat <- data.frame(x = node_data$x, y = node_data$y) nCluster <- ifelse( is.null(nCluster), floor(sqrt(nrow(dat))), min(nCluster, nrow(dat)) ) node_data$color2 <- tryCatch( expr = clusterFunction(dat, nCluster)$cluster, error = function(e) { message(wrongMessage) clusterFunction(dat, nCluster)$cluster } ) if (is.null(node_data$color2)) { message(wrongMessage) node_data$color2 <- clusterFunction(dat, nCluster)$cluster } } goid <- enrichDf$ID cluster_color <- unique(node_data$color2) clusters <- lapply(cluster_color, function(i) { goid[which(node_data$color2 == i)] }) cluster_label <- sapply( cluster_color, get_wordcloud, node_data = node_data, nWords = nWords ) names(cluster_label) <- cluster_color node_data$color2 <- cluster_label[as.character(node_data$color2)] return(node_data) } #' Add ellipse to group nodes #' #' @param node_data node data frame #' @param group_legend Logical, if TRUE, the grouping legend will be displayed. #' The default is FALSE. #' @param label logical, TRUE to label the ellipse (default) #' @param ellipse_style style of ellipse, one of "ggforce" and "polygon". #' @param ellipse_pro numeric indicating confidence value for the ellipses #' @param alpha the transparency of ellipse fill. #' @importFrom rlang check_installed #' @importFrom ggplot2 scale_fill_discrete #' @noRd add_ellipse <- function( node_data, group_legend, label = TRUE, ellipse_style = "ggforce", # ellipse_pro = 0.95, alpha = 0.3, ... ) { show_legend <- c(group_legend, FALSE) names(show_legend) <- c("fill", "color") ellipse_style <- match.arg(ellipse_style, c("ggforce", "polygon")) check_installed('ggforce', 'for `add_ellipse()`.'); if (ellipse_style == "ggforce") { if (label) { p <- ggforce::geom_mark_ellipse( data = node_data, aes( x = !!sym('x'), y = !!sym('y'), fill = !!sym('color2'), label = !!sym('color2') ), alpha = alpha, color = NA, show.legend = show_legend ) } else { p <- ggforce::geom_mark_ellipse( data = node_data, aes(x = !!sym('x'), y = !!sym('y'), fill = !!sym('color2')), alpha = alpha, color = NA, show.legend = show_legend ) } } # not in used if (FALSE && ellipse_style == "polygon") { ellipse_pro <- 0.95 # Define default ellipse_pro value p <- ggplot2::stat_ellipse( data = node_data, aes(x = !!sym('x'), y = !!sym('y'), fill = !!sym('color2')), geom = "polygon", level = ellipse_pro, alpha = alpha, show.legend = group_legend, ... ) } if (group_legend) { p <- list(p, scale_fill_discrete(name = "groups")) } return(p) } list2df <- ggtangle:::list2df ================================================ FILE: R/enrichplot-package.R ================================================ #' @keywords internal "_PACKAGE" ================================================ FILE: R/ggtable.R ================================================ #' plot table #' #' #' @title ggtable #' @param d data frame #' @param p ggplot object to extract color to color rownames(d), optional #' @importFrom rlang check_installed #' @return ggplot object #' @export #' @author guangchuang yu ggtable <- function(d, p = NULL) { # has_package("ggplotify") check_installed('ggplotify', 'for `ggtable()`.') ggplotify::as.ggplot(tableGrob2(d, p)) } #' @importFrom grid gpar #' @importFrom ggplot2 ggplot_build #' @importFrom rlang check_installed tableGrob2 <- function(d, p = NULL, rows=NULL) { # has_package("gridExtra") order_index <- order(rownames(d)) d <- d[order_index,] if (!is.null(rows)) { rows <- rows[order_index] } check_installed('gridExtra', 'for `tableGrob2()`.') tp <- gridExtra::tableGrob(d, rows=rows) if (is.null(p) || is.null(rows)) { return(tp) } # Fix bug: The 'group' order of lines and dots/path is different p_data <- ggplot_build(p)$data[[1]] # pcol <- unique(ggplot_build(p)$data[[1]][["colour"]]) p_data <- p_data[order(p_data[["group"]]), ] pcol <- unique(p_data[["colour"]]) ## This is fine too ## pcol <- unique(p_data[["colour"]])[unique(p_data[["group"]])] j <- which(tp$layout$name == "rowhead-fg") for (i in seq_along(pcol)) { tp$grobs[j][[i+1]][["gp"]] <- gpar(col = pcol[i]) } return(tp) } ================================================ FILE: R/goplot.R ================================================ #' @rdname goplot #' @exportMethod goplot setMethod("goplot", signature(x = "enrichResult"), function(x, showCategory = 10, color = "p.adjust", layout = igraph::layout_with_sugiyama, geom="text", ...) { goplot.enrichResult(x, showCategory = showCategory, color = color, layout = layout, geom = geom, ...) }) #' @rdname goplot #' @exportMethod goplot setMethod("goplot", signature(x = "gseaResult"), function(x, showCategory = 10, color = "p.adjust", layout = igraph::layout_with_sugiyama, geom="text", ...) { goplot.enrichResult(x, showCategory = showCategory, color = color, layout = layout, geom = geom, ...) }) #' @importFrom utils data #' @import GOSemSim #' @importFrom ggplot2 scale_fill_gradientn #' @importFrom grid arrow #' @importFrom grid unit #' @importFrom rlang check_installed #' @importFrom yulab.utils get_cache_item goplot.enrichResult <- function(x, showCategory = 10, color = "p.adjust", layout = igraph::layout_with_sugiyama, geom = "text", ID = "Description", ...) { segment.size <- get_ggrepel_segsize() # has_package("AnnotationDbi") n <- update_n(x, showCategory) geneSets <- geneInCategory(x) ## use core gene for gsea result y <- as.data.frame(x) y <- y[1:n,] id <- y$ID[1:n] GOSemSim_initial() .GOSemSimEnv <- get_cache_item(".GOSemSimEnv") gotbl <- .GOSemSimEnv$gotbl if (inherits(gotbl, "character")) { utils::data("gotbl", package = "GOSemSim", envir = environment()) gotbl <- get("gotbl") } if (inherits(x, "gseaResult")) { onto <- x@setType } else { onto <- x@ontology } if (!toupper(onto) %in% c("MF", "CC", "BP")) { stop("Ontology should be one of 'MF', 'CC' or 'BP'") } GOANCESTOR <- getAncestors(onto) anc <- GOANCESTOR[id] ca <- anc[[1]] for (i in 2:length(anc)) { ca <- intersect(ca, anc[[i]]) } uanc <- unique(unlist(anc)) uanc <- uanc[!uanc %in% ca] dag <- gotbl[gotbl$go_id %in% unique(c(id, uanc)),] edge <- dag[, c(5, 1, 4)] node <- unique(gotbl[gotbl$go_id %in% unique(c(edge[,1], edge[,2])), 1:3]) node$color <- x[node$go_id, color] node$size <- sapply(geneSets[node$go_id], length) g <- graph_from_data_frame(edge, directed=TRUE, vertices=node) E(g)$relationship <- edge[,3] check_installed('ggarchery', 'for `goplot()`.') position = ggarchery::position_attractsegment( start_shave=.03, end_shave=.03, type_shave="proportion" ) p <- ggplot(g, layout = layout) + geom_edge(aes(linetype = .data$relationship), arrow = arrow(length = unit(2, 'mm')), colour="darkgrey", position=position, linewidth = 1) if (ID == "Description" || ID == "ID") { ID <- sprintf("{%s}", ID) } if (geom == "label") { p <- p + geom_label_repel(aes(label= glue::glue(ID, ID=.data[['name']], Description=.data[['Term']]), fill=.data$color, segment.size = segment.size)) + set_enrichplot_color(type = "fill", name = color, na.value="white") } else { p <- p + geom_point(aes(color=.data$color), size=5) + geom_text_repel(aes(label=glue::glue(ID, ID=.data[['name']], Description=.data[['Term']])), segment.size = segment.size, bg.color="white", bg.r=.1) + set_enrichplot_color(type = "color", name = color, na.value="grey") } return(p) } #' @importFrom utils getFromNamespace GOSemSim_initial <- getFromNamespace(".initial", "GOSemSim") getAncestors <- getFromNamespace("getAncestors", "GOSemSim") ================================================ FILE: R/gseaplot.R ================================================ #' @rdname gseaplot #' @exportMethod gseaplot setMethod( "gseaplot", signature(x = "gseaResult"), function( x, geneSetID, by = "all", title = "", color = 'black', color.line = "green", color.vline = "#FA5860", ... ) { gseaplot.gseaResult( x, geneSetID = geneSetID, by = by, title = title, color = color, color.line = color.line, color.vline = color.vline, ... ) } ) #' @rdname gseaplot #' @param color color of line segments #' @param color.line color of running enrichment score line #' @param color.vline color of vertical line indicating the #' maximum/minimal running enrichment score #' @return ggplot2 object #' @importFrom ggplot2 ggplot #' @importFrom ggplot2 geom_linerange #' @importFrom ggplot2 geom_line #' @importFrom ggplot2 geom_vline #' @importFrom ggplot2 geom_hline #' @importFrom ggplot2 xlab #' @importFrom ggplot2 ylab #' @importFrom ggplot2 xlim #' @importFrom ggplot2 aes #' @importFrom ggplot2 ggplotGrob #' @importFrom ggplot2 geom_segment #' @importFrom ggplot2 ggplot_gtable #' @importFrom ggplot2 ggplot_build #' @importFrom ggplot2 ggtitle #' @importFrom ggplot2 element_text #' @importFrom ggplot2 rel #' @importFrom aplot plot_list #' @author Guangchuang Yu gseaplot.gseaResult <- function( x, geneSetID, by = "all", title = "", color = 'black', color.line = "green", color.vline = "#FA5860", ... ) { by <- match.arg(by, c("runningScore", "preranked", "all")) gsdata <- gsInfo(x, geneSetID) p <- ggplot(gsdata, aes(x = .data$x)) + theme_dose() + xlab("Position in the Ranked List of Genes") if (by == "runningScore" || by == "all") { p.res <- p + geom_linerange( aes(ymin = .data$ymin, ymax = .data$ymax), color = color ) p.res <- p.res + geom_line( aes(y = .data$runningScore), color = color.line, linewidth = 1 ) enrichmentScore <- x@result[geneSetID, "enrichmentScore"] es.df <- data.frame( es = which.min(abs(p$data$runningScore - enrichmentScore)) ) p.res <- p.res + geom_vline( data = es.df, aes(xintercept = .data$es), colour = color.vline, linetype = "dashed" ) p.res <- p.res + ylab("Running Enrichment Score") p.res <- p.res + geom_hline(yintercept = 0) } if (by == "preranked" || by == "all") { df2 <- data.frame(x = which(p$data$position == 1)) df2$y <- p$data$geneList[df2$x] p.pos <- p + geom_segment( data = df2, aes(x = .data$x, xend = .data$x, y = .data$y, yend = 0), color = color ) p.pos <- p.pos + ylab("Ranked List Metric") + xlim(0, length(p$data$geneList)) } if (by == "runningScore") { return(p.res + ggtitle(title)) } if (by == "preranked") { return(p.pos + ggtitle(title)) } p.pos <- p.pos + xlab(NULL) + theme(axis.text.x = element_blank(), axis.ticks.x = element_blank()) p.pos <- p.pos + ggtitle(title) + theme(plot.title = element_text(hjust = 0.5, size = rel(2))) #plot_list(gglist = list(p.pos, p.res), ncol=1) aplot::gglist(gglist = list(p.pos, p.res), ncol = 1) } #' extract gsea result of selected geneSet #' #' #' @title gsInfo #' @param object gseaResult object #' @param geneSetID gene set ID #' @return data.frame #' @author Guangchuang Yu ## @export gsInfo <- function(object, geneSetID) { geneList <- object@geneList if (is.numeric(geneSetID)) { geneSetID <- object@result[geneSetID, "ID"] } geneSet <- object@geneSets[[geneSetID]] exponent <- object@params[["exponent"]] df <- gseaScores(geneList, geneSet, exponent, fortify = TRUE) df$ymin <- 0 df$ymax <- 0 pos <- df$position == 1 h <- diff(range(df$runningScore)) / 20 df$ymin[pos] <- -h df$ymax[pos] <- h df$geneList <- geneList if (length(object@gene2Symbol) == 0) { df$gene <- names(geneList) } else { df$gene <- object@gene2Symbol[names(geneList)] } df$Description <- object@result[geneSetID, "Description"] return(df) } get_gsdata <- function(x, geneSetID) { if (length(geneSetID) == 1) { gsdata <- gsInfo(x, geneSetID) return(gsdata) } lapply(geneSetID, gsInfo, object = x) |> yulab.utils::rbindlist() } #' Horizontal plot for GSEA result #' #' #' @title hplot #' @param x gseaResult object #' @param geneSetID gene set ID #' @return horizontal plot #' @export #' @author Guangchuang Yu hplot <- function(x, geneSetID) { if (!inherits(x, "gseaResult")) { stop("hplot only work for GSEA result") } gsdata <- get_gsdata(x, geneSetID) ggplot(gsdata, aes(.data$x, .data$runningScore)) + ggHoriPlot::geom_horizon(origin = 'min', horizonscale = 4) + facet_grid(Description ~ .) + #ggHoriPlot::scale_fill_hcl(palette = 'Peach', reverse = TRUE) + ggHoriPlot::scale_fill_hcl(palette = 'BluGrn', reverse = TRUE) + theme_minimal() + ggfun::theme_noyaxis() + theme( panel.spacing.y = unit(0, "lines"), strip.text.y = element_text(angle = 0), legend.position = 'none', panel.border = element_blank(), panel.grid = element_blank(), ) + xlab(NULL) + ylab(NULL) } #' GSEA plot that mimic the plot generated by broad institute's GSEA software #' #' #' @title gseaplot2 #' @param x gseaResult object #' @param geneSetID gene set ID #' @param title plot title #' @param color color of running enrichment score line #' @param base_size base font size #' @param rel_heights relative heights of subplots #' @param subplots which subplots to be displayed #' @param pvalue_table whether add pvalue table #' @param pvalue_table_columns selected columns to be plotted in the `pvalue_table` #' @param pvalue_table_rownames selected column as the rownames of the `pvalue_table`. If set to NULL, no rownames will be displayed. #' @param ES_geom geom for plotting running enrichment score, #' one of 'line' or 'dot' #' @return plot #' @export #' @importFrom ggplot2 theme_classic #' @importFrom ggplot2 element_line #' @importFrom ggplot2 element_text #' @importFrom ggplot2 element_blank #' @importFrom ggplot2 element_rect #' @importFrom ggplot2 scale_x_continuous #' @importFrom ggplot2 scale_y_continuous #' @importFrom ggplot2 scale_color_manual #' @importFrom ggplot2 theme_void #' @importFrom ggplot2 geom_rect #' @importFrom ggplot2 margin #' @importFrom ggplot2 annotation_custom #' @importFrom stats quantile #' @importFrom RColorBrewer brewer.pal #' @author Guangchuang Yu gseaplot2 <- function( x, geneSetID, title = "", color = "green", base_size = 11, rel_heights = c(1.5, .5, 1), subplots = 1:3, pvalue_table = FALSE, pvalue_table_columns = c("pvalue", "p.adjust"), pvalue_table_rownames = "Description", ES_geom = "line" ) { ES_geom <- match.arg(ES_geom, c("line", "dot")) geneList <- position <- NULL ## to satisfy codetool gsdata <- get_gsdata(x, geneSetID) p <- ggplot(gsdata, aes(x = .data$x)) + xlab(NULL) + theme_classic(base_size) + theme( panel.grid.major = element_line(colour = "grey92"), panel.grid.minor = element_line(colour = "grey92"), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank() ) + scale_x_continuous(expand = c(0, 0)) if (ES_geom == "line") { es_layer <- geom_line( aes(y = .data$runningScore, color = .data$Description), linewidth = 1 ) } else { es_layer <- geom_point( aes(y = .data$runningScore, color = .data$Description), size = 1, data = subset(gsdata, position == 1) ) } p.res <- p + es_layer + theme( legend.position = "inside", legend.position.inside = c(.8, .8), legend.title = element_blank(), legend.background = element_rect(fill = "transparent") ) p.res <- p.res + ylab("Running Enrichment Score") + theme( axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.line.x = element_blank(), plot.margin = margin(t = .2, r = .2, b = 0, l = .2, unit = "cm") ) # Vectorized ymin/ymax assignment terms <- unique(gsdata$Description) term_indices <- match(gsdata$Description, terms) - 1 idx <- which(gsdata$ymin != 0) gsdata[idx, "ymin"] <- term_indices[idx] gsdata[idx, "ymax"] <- term_indices[idx] + 1 p2 <- ggplot(gsdata, aes(x = .data$x)) + geom_linerange(aes( ymin = .data$ymin, ymax = .data$ymax, color = .data$Description )) + xlab(NULL) + ylab(NULL) + theme_classic(base_size) + theme( legend.position = "none", plot.margin = margin(t = -.1, b = 0, unit = "cm"), axis.ticks = element_blank(), axis.text = element_blank(), axis.line.x = element_blank() ) + scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) if (length(geneSetID) == 1) { ## geneList <- gsdata$geneList ## j <- which.min(abs(geneList)) ## v1 <- quantile(geneList[1:j], seq(0,1, length.out=6))[1:5] ## v2 <- quantile(geneList[j:length(geneList)], seq(0,1, length.out=6))[1:5] ## v <- sort(c(v1, v2)) ## inv <- findInterval(geneList, v) v <- seq(1, sum(gsdata$position), length.out = 9) inv <- findInterval(rev(cumsum(gsdata$position)), v) if (min(inv) == 0) { inv <- inv + 1 } col <- c(rev(brewer.pal(5, "Blues")), brewer.pal(5, "Reds")) ymin <- min(p2$data$ymin) yy <- max(p2$data$ymax - p2$data$ymin) * .3 xmin <- which(!duplicated(inv)) xmax <- xmin + as.numeric(table(inv)[as.character(unique(inv))]) d <- data.frame( ymin = ymin, ymax = yy, xmin = xmin, xmax = xmax, col = col[unique(inv)] ) p2 <- p2 + geom_rect( aes( xmin = .data$xmin, xmax = .data$xmax, ymin = .data$ymin, ymax = .data$ymax, fill = I(col) ), data = d, alpha = .9, inherit.aes = FALSE ) } ## p2 <- p2 + ## geom_rect(aes(xmin=x-.5, xmax=x+.5, fill=geneList), ## ymin=ymin, ymax = ymin + yy, alpha=.5) + ## theme(legend.position="none") + ## scale_fill_gradientn(colors=color_palette(c("blue", "red"))) df2 <- p$data #data.frame(x = which(p$data$position == 1)) df2$y <- p$data$geneList[df2$x] p.pos <- p + geom_segment( data = df2, aes(x = .data$x, xend = .data$x, y = .data$y, yend = 0), color = "grey" ) p.pos <- p.pos + ylab("Ranked List Metric") + xlab("Rank in Ordered Dataset") + theme( plot.margin = margin(t = -.1, r = .2, b = .2, l = .2, unit = "cm") ) if (!is.null(title) && !is.na(title) && title != "") { p.res <- p.res + ggtitle(title) } if (length(color) == length(geneSetID)) { p.res <- p.res + scale_color_manual(values = color) if (length(color) == 1) { p.res <- p.res + theme(legend.position = "none") p2 <- p2 + scale_color_manual(values = "black") } else { p2 <- p2 + scale_color_manual(values = color) } } if (pvalue_table) { pd <- x[geneSetID, pvalue_table_columns] # pd <- pd[order(pd[,1], decreasing=FALSE),] if (is.null(pvalue_table_rownames)) { rows <- NULL } else { # rownames(pd) <- pd$Description if (length(pvalue_table_rownames) != 1) { stop( "the length of `pvalue_table_rownames` should be equal to 1" ) } rows <- x[geneSetID, pvalue_table_rownames] } # pd <- round(pd, 4) for (i in seq_len(ncol(pd))) { pd[, i] <- format(pd[, i], digits = 4) } tp <- tableGrob2(d = pd, p = p.res, rows = rows) p.res <- p.res + theme(legend.position = "none") + annotation_custom( tp, xmin = quantile(p.res$data$x, .5), xmax = quantile(p.res$data$x, .95), ymin = quantile(p.res$data$runningScore, .75), ymax = quantile(p.res$data$runningScore, .9) ) } plotlist <- list(p.res, p2, p.pos)[subplots] n <- length(plotlist) plotlist[[n]] <- plotlist[[n]] + theme( axis.line.x = element_line(), axis.ticks.x = element_line(), axis.text.x = element_text() ) if (length(subplots) == 1) { return( plotlist[[1]] + theme( plot.margin = margin( t = .2, r = .2, b = .2, l = .2, unit = "cm" ) ) ) } if (length(rel_heights) > length(subplots)) { rel_heights <- rel_heights[subplots] } # aplot::plot_list(gglist = plotlist, ncol=1, heights=rel_heights) aplot::gglist(gglist = plotlist, ncol = 1, heights = rel_heights) } #' plot ranked list of genes with running enrichment score as bar height #' #' #' @title gsearank #' @param x gseaResult object #' @param geneSetID gene set ID #' @param title plot title #' @param output one of 'plot' or 'table' (for exporting data) #' @return ggplot object #' @importFrom ggplot2 geom_segment #' @importFrom ggplot2 theme_minimal #' @export #' @author Guangchuang Yu gsearank <- function(x, geneSetID, title = "", output = "plot") { output <- match.arg(output, c("plot", "table")) position <- NULL gsdata <- gsInfo(x, geneSetID) gsdata <- subset(gsdata, position == 1) if (output == "table") { res <- gsdata[, c("gene", "x", "runningScore")] if (x[geneSetID, "NES"] > 0) { res$core <- "NO" res$core[1:which.max(gsdata$runningScore)] <- "YES" } else { res$core <- "NO" res$core[which.min(gsdata$runningScore):nrow(res)] <- "YES" } names(res) <- c( "gene", "rank in geneList", "running ES", "core enrichment" ) rownames(res) <- NULL return(res) } p <- ggplot(gsdata, aes(x = .data$x, y = .data$runningScore)) + geom_segment(aes(xend = .data$x, yend = 0)) + ggtitle(title) + xlab("Position in the Ranked List of Genes") + ylab("Running Enrichment Score") + theme_minimal() return(p) } #' label genes in running score plot #' #' #' @title geom_gsea_gene #' @param genes selected genes to be labeled #' @param mapping aesthetic mapping, default is NULL #' @param geom geometric layer to plot the gene labels, default is geom_text #' @param ... additional parameters passed to the 'geom' #' @param geneSet choose which gene set(s) to be label if the plot contains multiple gene sets #' @return ggplot object #' @importFrom rlang .data #' @export #' @author Guangchuang Yu geom_gsea_gene <- function( genes, mapping = NULL, geom = ggplot2::geom_text, ..., geneSet = NULL ) { default_mapping <- aes( x = .data$x, y = .data$runningScore, label = .data$gene ) if (is.null(mapping)) { mapping <- default_mapping } else { mapping <- modifyList(default_mapping, mapping) } if (is.null(geneSet)) { data <- ggtree::td_filter(.data$gene %in% genes) } else { data <- ggtree::td_filter( .data$gene %in% genes & .data$Description %in% geneSet ) } geom(mapping = mapping, data = data, ...) } ================================================ FILE: R/heatplot.R ================================================ #' @rdname heatplot #' @exportMethod heatplot setMethod( "heatplot", signature(x = "enrichResult"), function(x, showCategory = 30, ...) { heatplot.enrichResult(x, showCategory, ...) } ) #' @rdname heatplot #' @exportMethod heatplot setMethod( "heatplot", signature(x = "gseaResult"), function(x, showCategory = 30, ...) { heatplot.enrichResult(x, showCategory, ...) } ) #' @rdname heatplot #' @importFrom ggplot2 geom_tile #' @importFrom ggplot2 theme_minimal #' @importFrom ggplot2 theme #' @importFrom ggplot2 element_blank #' @importFrom ggplot2 element_text #' @importFrom ggplot2 scale_y_discrete #' @importFrom ggplot2 scale_fill_gradient2 #' @importFrom rlang check_installed #' @param showTop number of top genes ranked by `abs(foldChange) * frequency` #' to be shown in the heatmap, default NULL means all genes are shown #' @param label_format a numeric value sets wrap length, alternatively a #' custom function to format axis labels. #' by default wraps names longer than 30 characters #' @param symbol symbol of the nodes, one of "rect" (the default) or "dot" #' @param pvalue pvalue of genes #' @author Guangchuang Yu heatplot.enrichResult <- function( x, showCategory = 30, showTop = NULL, symbol = "rect", foldChange = NULL, pvalue = NULL, label_format = 30 ) { symbol <- match.arg(symbol, c("rect", "dot")) label_func <- default_labeller(label_format) if (is.function(label_format)) { label_func <- label_format } n <- update_n(x, showCategory) geneSets <- extract_geneSets(x, n) if (!is.null(showTop) && showTop > 0) { nfreq <- table(unlist(geneSets)) nfc <- nfreq * abs(foldChange[names(nfreq)]) topgenes <- head(names(sort(nfc, decreasing = TRUE)), showTop) geneSets <- lapply(geneSets, function(s) intersect(s, topgenes)) } foldChange <- fc_readable(x, foldChange) pvalue <- fc_readable(x, pvalue) d <- list2df(geneSets) if (!is.null(foldChange)) { d$foldChange <- foldChange[as.character(d[, 2])] } if (!is.null(pvalue)) { d$pvalue <- pvalue[as.character(d[, 2])] } p <- ggplot(d, aes(x = .data$Gene, y = .data$categoryID)) if (symbol == "rect") { p <- p + geom_tile(color = 'white') } get_dotp <- function(p, foldChange, pvalue) { if (is.null(foldChange) && is.null(pvalue)) { p <- p + geom_point( color = 'black', shape = 21, fill = "black", size = 5 ) return(p) } if (!is.null(foldChange) && !is.null(pvalue)) { p <- p + geom_point(color = 'black', shape = 21) return(p) } if (is.null(foldChange)) { p <- p + geom_point(color = 'black', shape = 21, fill = "black") } else { p <- p + geom_point(color = 'black', shape = 21, size = 5) } return(p) } # copy from https://stackoverflow.com/questions/11053899/how-to-get-a-reversed-log10-scale-in-ggplot2 reverselog_trans <- function(base = exp(1)) { trans <- function(x) -log(x, base) check_installed('scales', 'for `heatplot()`.') inv <- function(x) base^(-x) scales::trans_new( paste0("reverselog-", format(base)), trans, inv, scales::log_breaks(base = base), domain = c(1e-100, Inf) ) } if (symbol == "dot") { p <- get_dotp(p, foldChange, pvalue) ## only dot need size(pvalue) parameter if (!is.null(pvalue)) { p <- p + aes(size = .data$pvalue) + scale_size_continuous( range = c(3, 8), trans = reverselog_trans(10) ) } } if (!is.null(foldChange)) { p <- p + aes(fill = !!sym('foldChange')) + set_enrichplot_color( colors = get_enrichplot_color(3), type = "fill", reverse = FALSE, transform = 'identity' ) } p + xlab(NULL) + ylab(NULL) + theme_minimal() + scale_y_discrete(labels = label_func) + theme( panel.grid.major = element_blank(), axis.text.x = element_text(angle = 60, hjust = 1) ) } ================================================ FILE: R/manhattanplot.R ================================================ #' @rdname manhattanplot #' @exportMethod manhattanplot #' @author Guangchuang Yu setMethod( "manhattanplot", signature(x = "enrichResult"), function( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) { manhattanplot.enrichResult( x = x, color = color, showCategory = showCategory, size = size, split = split, font.size = font.size, title = title, label_format = label_format, ... ) } ) #' @rdname manhattanplot #' @exportMethod manhattanplot setMethod( "manhattanplot", signature(x = "gseaResult"), function( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) { manhattanplot.enrichResult( x = x, color = color, showCategory = showCategory, size = size, split = split, font.size = font.size, title = title, label_format = label_format, ... ) } ) #' @rdname manhattanplot #' @aliases manhattanplot,compareClusterResult,ANY-method #' @exportMethod manhattanplot setMethod( "manhattanplot", signature(x = "compareClusterResult"), function( x, color = "p.adjust", showCategory = 5, split = NULL, font.size = 12, title = "", size = "Count", includeAll = TRUE, label_format = 30, ... ) { manhattanplot.compareClusterResult( x, colorBy = color, showCategory = showCategory, size = size, includeAll = includeAll, split = split, font.size = font.size, title = title, label_format = label_format, ... ) } ) #' @rdname manhattanplot #' @exportMethod manhattanplot #' @aliases manhattanplot,enrichResultList,ANY-method setMethod( "manhattanplot", signature(x = "enrichResultList"), function( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) { manhattanplot.enrichResult( x = x, color = color, showCategory = showCategory, size = size, split = split, font.size = font.size, title = title, label_format = label_format, ... ) } ) #' @rdname manhattanplot #' @exportMethod manhattanplot #' @aliases manhattanplot,gseaResultList,ANY-method setMethod( "manhattanplot", signature(x = "gseaResultList"), function( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) { manhattanplot.enrichResult( x = x, color = color, showCategory = showCategory, size = size, split = split, font.size = font.size, title = title, label_format = label_format, ... ) } ) #' @rdname manhattanplot #' @exportMethod manhattanplot #' @aliases manhattanplot,list,ANY-method setMethod( "manhattanplot", signature(x = "list"), function( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) { if (all(sapply(x, function(i) inherits(i, "enrichResult") || inherits(i, "gseaResult")))) { class(x) <- "enrichResultList" manhattanplot( x = x, color = color, showCategory = showCategory, size = size, split = split, font.size = font.size, title = title, label_format = label_format, ... ) } else { stop("all elements in the list should be enrichResult or gseaResult objects") } } ) #' Internal helper function for manhattan build #' @noRd .get_ontology <- function(x) { if ("ontology" %in% methods::slotNames(x) && length(x@ontology) > 0 && x@ontology != "") { return(x@ontology) } if ("fun" %in% methods::slotNames(x) && length(x@fun) > 0 && x@fun != "") { if (x@fun == "enrichGO" || x@fun == "gseGO") { return("GO") } res <- gsub("enrich", "", x@fun) res <- gsub("gse", "", res) return(res) } return("Enrichment") } .prep_manhattan_df <- function(df, colorBy) { if (nrow(df) == 0) return(list(df = df)) grp_col <- "ONTOLOGY" if (!"ONTOLOGY" %in% colnames(df)) { if ("Category" %in% colnames(df)) { grp_col <- "Category" } else { df$ONTOLOGY <- "Enrichment" } } unique_terms <- unique(df[, c("ID", grp_col)]) unique_terms <- unique_terms[order(unique_terms[[grp_col]], unique_terms$ID), ] unique_terms$x_pos <- NA grps <- unique(unique_terms[[grp_col]]) current_x <- 0 ticks <- numeric(length(grps)) gap <- max(1, nrow(unique_terms) * 0.05) for (i in seq_along(grps)) { grp <- grps[i] idx <- which(unique_terms[[grp_col]] == grp) n <- length(idx) unique_terms$x_pos[idx] <- current_x + (1:n) ticks[i] <- current_x + n / 2 current_x <- current_x + n + gap } df <- merge(df, unique_terms, by = c("ID", grp_col)) # Calculate y df$y <- -log10(df[[colorBy]]) list(df = df, ticks = ticks, grps = grps, grp_col = grp_col) } .manhattanplot_internal <- function(df, ticks, grps, grp_col, hl_df, size, colorBy, label_func, font.size, title, size_range = c(3, 8)) { p <- ggplot(df, aes(x = .data$x_pos, y = .data$y)) + geom_point(aes(size = .data[[size]], fill = .data[[grp_col]]), shape = 21, alpha = 0.8) + scale_x_continuous(breaks = ticks, labels = grps) + ylab(paste0("-log10(", colorBy, ")")) + xlab(NULL) + ggtitle(title) + theme_dose(font.size) + theme( panel.grid.minor = element_blank(), panel.grid.major.x = element_blank(), axis.text.x = element_text(angle = 45, hjust = 1) ) if (size == "Count" && !is.null(df[[size]])) { tryCatch({ size_break <- pretty(df[[size]], n = 4) p <- p + scale_size(range = size_range, breaks = size_break) }, error = function(e) { p <- p + scale_size(range = size_range) }) } else { p <- p + scale_size(range = size_range) } if (nrow(hl_df) > 0) { rlang::check_installed('ggrepel', 'for labeling in `manhattanplot()`.') hl_df$label <- label_func(hl_df$Description) p <- p + ggrepel::geom_text_repel( data = hl_df, aes(x = .data$x_pos, y = .data$y, label = .data$label), size = font.size / 3, min.segment.length = 0, box.padding = 0.5, show.legend = FALSE ) } class(p) <- c("enrichplotManhattan", class(p)) return(p) } #' @importFrom ggplot2 ggplot aes geom_point scale_x_continuous xlab ylab ggtitle theme element_text element_blank scale_size theme_void #' @importFrom utils head manhattanplot.enrichResult <- function( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) { colorBy <- match.arg(color, c("pvalue", "p.adjust", "qvalue")) if (inherits(x, c("enrichResultList", "gseaResultList"))) { ldf <- lapply(x, as.data.frame) n_all <- sum(sapply(ldf, nrow)) if (n_all == 0) return(ggplot() + theme_void()) ldf <- lapply(seq_along(x), function(i) { obj <- x[[i]] df_i <- fortify(obj, showCategory = nrow(as.data.frame(obj))) if (!"ONTOLOGY" %in% colnames(df_i)) { df_i$ONTOLOGY <- .get_ontology(obj) } return(df_i) }) names(ldf) <- names(x) df <- dplyr::bind_rows(ldf, .id = "category") df$category <- factor(df$category, levels = names(x)) } else { n_all <- nrow(as.data.frame(x)) if (n_all == 0) return(ggplot() + theme_void()) df <- fortify(x, showCategory = n_all, split = split) if (!"ONTOLOGY" %in% colnames(df)) { df$ONTOLOGY <- .get_ontology(x) } } res <- .prep_manhattan_df(df, colorBy) df <- res$df if (!is.null(showCategory) && showCategory > 0) { df_ord <- df[order(df$y, decreasing = TRUE), ] hl_df <- head(df_ord, showCategory) } else { hl_df <- df[0, ] } label_func <- .label_format(label_format) p <- .manhattanplot_internal( df = df, ticks = res$ticks, grps = res$grps, grp_col = res$grp_col, hl_df = hl_df, size = size, colorBy = colorBy, label_func = label_func, font.size = font.size, title = title ) return(p) } #' @importFrom ggplot2 facet_grid manhattanplot.compareClusterResult <- function( x, colorBy = "p.adjust", showCategory = 5, size = "Count", split = NULL, includeAll = TRUE, font.size = 12, title = "", label_format = 30, facet = "Cluster", strip_width = 15, ... ) { if (!is.null(facet) && facet == "intersect") { x <- append_intersect(x) } n_all <- nrow(as.data.frame(x)) if (n_all == 0) return(ggplot() + theme_void()) df <- fortify(x, showCategory = n_all, includeAll = includeAll, split = split) if (!"ONTOLOGY" %in% colnames(df)) { df$ONTOLOGY <- .get_ontology(x) } # In single enrich we didn't use `colorBy`, we used `color`. For compare we mapped it to colorBy. colorBy <- match.arg(colorBy, c("pvalue", "p.adjust", "qvalue")) res <- .prep_manhattan_df(df, colorBy) df <- res$df if (!is.null(showCategory) && showCategory > 0) { df_ord <- df[order(df$y, decreasing = TRUE), ] hl_df <- do.call(rbind, by(df_ord, df_ord[[facet]], head, n = showCategory)) } else { hl_df <- df[0, ] } label_func <- .label_format(label_format) p <- .manhattanplot_internal( df = df, ticks = res$ticks, grps = res$grps, grp_col = res$grp_col, hl_df = hl_df, size = size, colorBy = colorBy, label_func = label_func, font.size = font.size, title = title ) if (!is.null(facet)) { p <- p + facet_grid( stats::reformulate(".", response = facet), scales = "free_y", space = 'fixed', switch = 'y', labeller = ggplot2::label_wrap_gen(strip_width) ) + theme(strip.text = element_text(size = 14)) } return(p) } ================================================ FILE: R/method-fortify.R ================================================ #' convert compareClusterResult to a data.frame that ready for plot #' #' #' @rdname fortify #' @title fortify #' @param includeAll logical #' @return data.frame #' @importFrom ggplot2 fortify #' @importFrom dplyr arrange #' @importFrom dplyr desc #' @importFrom dplyr group_by #' @importFrom dplyr slice_head #' @importFrom dplyr ungroup #' @importFrom dplyr bind_rows #' @importFrom dplyr mutate #' @importFrom dplyr %>% #' @export #' @author Guangchuang Yu fortify.compareClusterResult <- function( model, data, showCategory = 5, by = "geneRatio", split = NULL, includeAll = TRUE, ... ) { clProf.df <- as.data.frame(model) .split <- split if ("core_enrichment" %in% colnames(clProf.df)) { clProf.df$Count <- str_count(clProf.df$core_enrichment, "/") clProf.df$.sign <- "activated" clProf.df$.sign[clProf.df$NES < 0] <- "suppressed" clProf.df$GeneRatio <- clProf.df$Count / clProf.df$setSize } ## get top 5 (default) categories of each gene cluster. if (is.null(showCategory)) { result <- clProf.df } else if (is.numeric(showCategory)) { topN <- function(res, showCategory) { if ("pvalue" %in% colnames(res)) { res <- arrange(res, .data$pvalue) } else { ## for groupGO res <- arrange(res, desc(.data$Count)) } res %>% group_by(.data$Cluster) %>% slice_head(n = showCategory) %>% ungroup() %>% as.data.frame() } if (!is.null(.split) && .split %in% colnames(clProf.df)) { lres <- split(clProf.df, as.character(clProf.df[, .split])) lres <- lapply(lres, topN, showCategory = showCategory) result <- as.data.frame(bind_rows(lres)) } else { result <- topN(clProf.df, showCategory) } } else { result <- subset(clProf.df, Description %in% showCategory) } ID <- NULL if (includeAll == TRUE) { result <- subset(clProf.df, ID %in% result$ID) } ## remove zero count result$Description <- as.character(result$Description) ## un-factor GOlevel <- result[, c("ID", "Description")] ## GO ID and Term GOlevel <- unique(GOlevel) result <- result[result$Count != 0, ] result$Description <- factor( result$Description, levels = unique(rev(GOlevel[, 2])) ) if (by == "rowPercentage") { Description <- Count <- NULL # to satisfy codetools result <- result %>% group_by(.data$Description) %>% mutate( Percentage = .data$Count / sum(.data$Count), Total = sum(.data$Count) ) %>% ungroup() %>% as.data.frame() ## label GO Description with gene counts. result$Description <- paste0(result$Description, " (", result$Total, ")") ## restore the original order of GO Description xx <- result[, c(2, 3)] xx <- unique(xx) rownames(xx) <- xx[, 1] Termlevel <- xx[as.character(GOlevel[, 1]), 2] ##drop the *Total* column result <- result[, colnames(result) != "Total"] result$Description <- factor( result$Description, levels = unique(rev(Termlevel)) ) } else if (by == "count") { result$GeneRatio <- yulab.utils::parse_ratio(result$GeneRatio) } else if (by == "geneRatio") { ## for result of ORA # if (class(result$GeneRatio) == "character" && grep("/", result$GeneRatio[1])) { if ( inherits(result$GeneRatio, "character") && grep("/", result$GeneRatio[1]) ) { gcsize <- as.numeric(sub( "^\\d+/", "", as.character(result$GeneRatio) )) result$GeneRatio <- yulab.utils::parse_ratio(result$GeneRatio) if ( ("ONTOLOGY" %in% colnames(result)) && (length(unique(result$ONTOLOGY)) > 1) ) { # do nothing } else { cluster <- paste( as.character(result$Cluster), "\n", "(", gcsize, ")", sep = "" ) orig_cls <- unique(result$Cluster) num_cls <- suppressWarnings(as.numeric(as.character(orig_cls))) if (any(is.na(num_cls))) { idx <- order(orig_cls) } else { idx <- order(num_cls) } lv <- unique(cluster)[idx] result$Cluster <- factor(cluster, levels = lv) } } } else { ## nothing } return(result) } #' convert enrichResult object for ggplot2 #' #' #' @title fortify #' @rdname fortify #' @param model 'enrichResult' or 'compareClusterResult' object #' @param data not use here #' @param showCategory Category numbers to show #' @param by one of Count and GeneRatio #' @param order logical #' @param drop logical #' @param split separate result by 'split' variable #' @param ... additional parameter #' @return data.frame #' @importFrom ggplot2 fortify ## @method fortify enrichResult #' @export fortify.enrichResult <- function( model, data, showCategory = 5, by = "Count", order = FALSE, drop = FALSE, split = NULL, ... ) { fortify_internal( model = model, data = data, showCategory = showCategory, by = by, order = order, drop = drop, split = split ) } ## @method fortify gseaResult #' @export fortify.gseaResult <- function( model, data, showCategory = 5, by = "Count", order = FALSE, drop = FALSE, split = NULL, ... ) { fortify_internal(model, data, showCategory, by, order, drop, split) } fortify_internal <- function( model, data, showCategory = 5, by = "Count", order = FALSE, drop = FALSE, split = NULL ) { res <- as.data.frame(model) res <- res[!is.na(res$Description), ] if (inherits(model, "gseaResult")) { res$Count <- str_count(res$core_enrichment, "/") res$.sign <- "activated" res$.sign[res$NES < 0] <- "suppressed" } if (drop) { res <- res[res$Count != 0, ] } if (inherits(model, "gseaResult")) { res$GeneRatio <- res$Count / res$setSize } else if (inherits(model, "enrichResult")) { res$GeneRatio <- parse_ratio(res$GeneRatio) if ("BgRatio" %in% colnames(res)) { ## groupGO output doesn't have this column res$BgRatio <- parse_ratio(res$BgRatio) } } if (order) { if (by == "Count") { idx <- order(res$Count, decreasing = TRUE) } else { idx <- order(res$GeneRatio, decreasing = TRUE) } res <- res[idx, ] } topN <- function(res, showCategory) { if (is.numeric(showCategory)) { if (showCategory <= nrow(res)) { res <- res[1:showCategory, ] } } else { ## selected categories res <- res[res$Description %in% showCategory, ] } return(res) } if (is.null(split)) { res <- topN(res, showCategory) } else { lres <- split(res, as.character(res[, split])) lres <- lapply(lres, topN, showCategory = showCategory) res <- do.call('rbind', lres) } res$Description <- factor( res$Description, levels = rev(unique(res$Description)) ) return(res) } str_count <- function(string, pattern = "") { sapply(string, FUN = function(i) { length(unlist(strsplit(i, split = pattern))) }) } parse_ratio <- function(ratio) { gsize <- as.numeric(sub("/\\d+$", "", as.character(ratio))) gcsize <- as.numeric(sub("^\\d+/", "", as.character(ratio))) return(gsize / gcsize) } ================================================ FILE: R/method-ggplot-add.R ================================================ #' @importFrom ggplot2 ggplot_add #' @method ggplot_add autofacet #' @export ggplot_add.autofacet <- function(object, plot, ...) { d <- plot$data nn <- names(d) if ('category' %in% nn) { var <- "category" } else if ('ONTOLOGY' %in% nn) { var <- 'ONTOLOGY' } else { message("not supported") return(plot) } if (!is.null(object$levels)) { d[[var]] <- factor(d[[var]], levels = object$levels) plot$data <- d } if (object$by == 'row') { obj <- facet_grid(.data[[var]] ~ ., scales=object$scales) } else { obj <- facet_grid(. ~ .data[[var]], scales=object$scales) } ggplot_add(obj, plot, ...) } ================================================ FILE: R/method-print.r ================================================ #' @method print enrichplotDot #' @export print.enrichplotDot <- function(x, ...) { p <- ggfun::set_point_legend_shape(x) class(p) <- class(p)[-1] print(p) } ================================================ FILE: R/pairwise_termsim.R ================================================ #' @rdname pairwise_termsim #' @exportMethod pairwise_termsim setMethod("pairwise_termsim", signature(x = "enrichResult"), function(x, method = "JC", semData = NULL, showCategory = NULL) { pairwise_termsim.enrichResult(x, method = method, semData = semData, showCategory = showCategory) }) #' @rdname pairwise_termsim #' @exportMethod pairwise_termsim setMethod("pairwise_termsim", signature(x = "gseaResult"), function(x, method = "JC", semData = NULL, showCategory = NULL) { pairwise_termsim.enrichResult(x, method = method, semData = semData, showCategory = showCategory) }) #' @rdname pairwise_termsim #' @exportMethod pairwise_termsim setMethod("pairwise_termsim", signature(x = "compareClusterResult"), function(x, method = "JC", semData = NULL, showCategory = NULL) { pairwise_termsim.compareClusterResult(x, method = method, semData = semData, showCategory = showCategory) }) #' @rdname pairwise_termsim pairwise_termsim.enrichResult <- function(x, method = "JC", semData = NULL, showCategory = NULL) { if (is.null(showCategory)) { showCategory <- .default_pairwise_termsim_category(x) } y <- as.data.frame(x) geneSets <- geneInCategory(x) n <- update_n(x, showCategory) if (n == 0) stop("no enriched term found...") if (is.numeric(n)) { y <- y[1:n, ] } else { y <- y[match(n, y$Description),] n <- length(n) } x@termsim <- get_similarity_matrix(y = y, geneSets = geneSets, method = method, semData = semData) x@method <- method return(x) } #' @rdname pairwise_termsim pairwise_termsim.compareClusterResult <- function(x, method = "JC", semData = NULL, showCategory = NULL) { if (is.null(showCategory)) { showCategory <- .default_pairwise_termsim_category(x) } y <- fortify(x, showCategory=showCategory, includeAll=TRUE, split=NULL) y$Cluster <- sub("\n.*", "", y$Cluster) ## y_union <- get_y_union(y = y, showCategory = showCategory) if ("core_enrichment" %in% colnames(y)) { y$geneID <- y$core_enrichment } y_union <- merge_compareClusterResult(y) geneSets <- setNames(strsplit(as.character(y_union$geneID), "/", fixed = TRUE), y_union$ID) x@termsim <- get_similarity_matrix(y = y_union, geneSets = geneSets, method = method, semData = semData) x@method <- method return(x) } .default_pairwise_termsim_category <- function(x, min_default = 200) { min(nrow(x), min_default) } ================================================ FILE: R/plot_utils.R ================================================ #' Plotting utility functions for enrichplot package #' #' This file contains plotting and visualization helper functions for enrichplot #' Automatically split barplot or dotplot into several facets #' #' @param by one of 'row' or 'column' #' @param scales whether 'fixed' or 'free' #' @param levels set facet levels #' @return a ggplot object #' @export autofacet <- function(by = 'row', scales = "free", levels = NULL) { structure( list(by = by, scales = scales, levels = levels), class = "autofacet" ) } #' Internal plot function for plotting compareClusterResult #' #' @param clProf.reshape.df data frame of compareCluster result #' @param x x variable #' @param type one of dot and bar #' @param by one of percentage and count #' @param title graph title #' @param font.size graph font size #' @param colorBy one of pvalue or p.adjust #' @return ggplot object #' @importFrom ggplot2 ggplot #' @importFrom ggplot2 aes #' @importFrom ggplot2 geom_bar #' @importFrom ggplot2 coord_flip #' @importFrom ggplot2 geom_point #' @importFrom ggplot2 %+% #' @importFrom ggplot2 theme #' @importFrom ggplot2 xlab #' @importFrom ggplot2 ylab #' @importFrom ggplot2 theme_bw #' @importFrom ggplot2 element_text #' @importFrom ggplot2 ggtitle #' @importFrom ggplot2 scale_color_continuous #' @importFrom ggplot2 guide_colorbar #' @author Guangchuang Yu plotting.clusterProfile <- function( clProf.reshape.df, x = ~Cluster, type = "dot", colorBy = "p.adjust", by = "geneRatio", title = "", font.size = 12 ) { if (type == "bar") { if (by == "percentage") { p <- ggplot( clProf.reshape.df, aes( x = !!sym("Description"), y = !!sym("Percentage"), fill = !!sym("Cluster") ) ) } else if (by == "count") { p <- ggplot( clProf.reshape.df, aes( x = !!sym("Description"), y = !!sym("Count"), fill = !!sym("Cluster") ) ) } else {} p <- p + geom_bar() + coord_flip() } p <- p + xlab("") + ylab("") + ggtitle(title) + theme_dose(font.size) return(p) } #' Get the distance of the label #' #' @param dimension one of 1 and 2 #' @param label_location label_location #' @return distance matrix #' @noRd get_label_diss <- function(dimension, label_location) { nn <- nrow(label_location) label_dis <- matrix(NA, nrow = nn, ncol = nn) colnames(label_dis) <- rownames(label_dis) <- label_location$label # Vectorized computation using outer vals <- label_location[[dimension]] label_dis <- outer(vals, vals, `-`) colnames(label_dis) <- rownames(label_dis) <- label_location$label # Convert to long format label_diss <- reshape2::melt(label_dis) label_diss <- label_diss[label_diss[, 1] != label_diss[, 2], ] label_diss <- label_diss[!is.na(label_diss[, 3]), ] label_diss[, 1] <- as.character(label_diss[, 1]) label_diss[, 2] <- as.character(label_diss[, 2]) return(label_diss) } #' Default labeller function #' #' Default labeling function that uses the #' internal string wrapping function `yulab.utils::str_wrap` #' @noRd #' @importFrom yulab.utils str_wrap default_labeller <- function(n) { fun <- function(str) { str <- gsub("_", " ", str) yulab.utils::str_wrap(str, n) } structure(fun, class = "labeller") } #' Get segment.size value for ggrepel #' #' @param default default value of ggrepel.segment.size #' @return segment size value #' @noRd get_ggrepel_segsize <- function(default = 0.2) { getOption("ggrepel.segment.size", default = default) } #' Get parameter change message #' #' @param parameter parameter name #' @param params_df parameter data frame #' @return warning message #' @noRd get_param_change_message <- function(parameter, params_df) { paste0( "Use '", params_df[parameter, "listname"], " = list(", params_df[parameter, "present"], " = your_value)' instead of '", params_df[parameter, "original"], "'" ) } ================================================ FILE: R/pmcplot.R ================================================ #' PubMed Central Trend plot #' #' #' @title pmcplot #' @param query query terms #' @param period period of query in the unit of year #' @param proportion If TRUE, use query_hits/all_hits, otherwise use query_hits. #' @return ggplot object #' @importFrom purrr map_df #' @importFrom rlang check_installed ## @importFrom europepmc epmc_hits_trend #' @importFrom utils modifyList #' @export #' @author Guangchuang Yu pmcplot <- function(query, period, proportion = TRUE) { check_installed('europepmc', 'for `pmcplot()`.') res <- map_df(query, function(x) { period <- get("period", parent.env(parent.env(new.env()))) y <- europepmc::epmc_hits_trend(query = x, period = period) y$query <- x return(y) }) mapping <- aes(x = .data$year, y = .data$query_hits, color = .data$query) ylab <- "Number of articles" if (proportion) { mapping <- modifyList(mapping, aes(y = .data$query_hits/.data$all_hits)) ylab <- "Proportion of articles" } ggplot(res, mapping) + geom_line() + geom_point() + xlab(NULL) + ylab(ylab) } ================================================ FILE: R/reexport.R ================================================ #' @importFrom ggplot2 ggtitle #' @export ggplot2::ggtitle #' @importFrom ggplot2 facet_grid #' @export ggplot2::facet_grid #' @importFrom aplot plot_list #' @export aplot::plot_list #' @importFrom ggtangle cnetplot #' @export ggtangle::cnetplot #' @importFrom DOSE theme_dose #' @export DOSE::theme_dose #' @importFrom ggtangle geom_cnet_label #' @export ggtangle::geom_cnet_label #' @importFrom enrichit gseaScores #' @export enrichit::gseaScores #' @importFrom enrichit geneID #' @export enrichit::geneID #' @importFrom enrichit geneInCategory #' @export enrichit::geneInCategory #' @importClassesFrom enrichit compareClusterResult NULL ================================================ FILE: R/ridgeplot.R ================================================ #' @rdname ridgeplot #' @exportMethod ridgeplot setMethod( "ridgeplot", signature(x = "gseaResult"), function( x, showCategory = 30, fill = "p.adjust", core_enrichment = TRUE, label_format = 30, ... ) { ridgeplot.gseaResult( x, showCategory = showCategory, fill = fill, core_enrichment = core_enrichment, label_format = label_format, ... ) } ) #' @rdname ridgeplot #' @param orderBy The order of the Y-axis #' @param decreasing logical. Should the orderBy order be increasing or decreasing? #' @param stat statistic passed to `ggridges::geom_density_ridges()`. #' @importFrom ggplot2 scale_fill_gradientn #' @importFrom ggplot2 scale_x_reverse #' @importFrom ggplot2 xlab #' @importFrom ggplot2 ylab #' @importFrom ggplot2 scale_y_discrete #' @importFrom rlang check_installed #' @importFrom yulab.utils yulab_abort #' @importFrom yulab.utils yulab_warn #' @author Guangchuang Yu ridgeplot.gseaResult <- function( x, showCategory = 30, fill = "p.adjust", core_enrichment = TRUE, label_format = 30, orderBy = "NES", decreasing = FALSE, stat = "density_ridges" ) { ## Input validation with better error messages check_input(x, type = "gseaResult", arg_name = "x") if (!fill %in% colnames(x@result)) { yulab_abort(paste0("'", fill, "' variable not available in result"), class = "missing_column_error") } ## geom_density_ridges <- get_fun_from_pkg('ggridges', 'geom_density_ridges') if (orderBy != 'NES' && !orderBy %in% colnames(x@result)) { yulab_warn('wrong orderBy parameter; set to default `orderBy = "NES"`', class = "parameter_warning") orderBy <- "NES" } ## Optimized category selection if (inherits(showCategory, 'numeric')) { selected <- seq_len(min(showCategory, nrow(x@result))) } else if (inherits(showCategory, "character")) { ii <- match(showCategory, x@result$Description) if (all(is.na(ii))) { ii <- match(showCategory, x@result$ID) } ii <- ii[!is.na(ii)] if (length(ii) == 0) { yulab_warn("No matching categories found, using first 10", class = "category_warning") ii <- seq_len(min(10, nrow(x@result))) } selected <- x@result[ii, "ID"] } else { yulab_warn("showCategory should be a number of pathways or a vector of selected pathways", class = "parameter_warning") selected <- seq_len(min(10, nrow(x@result))) } ## Optimized gene set extraction if (core_enrichment) { gs2id <- geneInCategory(x)[selected] } else { gs2id <- x@geneSets[names(x@geneSets) %in% selected] } ## Optimized gene name mapping if (x@readable && length(x@gene2Symbol) > 0) { gene_names <- names(x@geneList) symbol_match <- match(gene_names, names(x@gene2Symbol)) valid_matches <- !is.na(symbol_match) names(x@geneList)[valid_matches] <- x@gene2Symbol[symbol_match[valid_matches]] } ## Vectorized data preparation gs2val <- lapply(gs2id, function(id) { res <- x@geneList[id] res[!is.na(res)] }) nn <- names(gs2val) i <- match(nn, x$ID) nn <- x$Description[i] ## Optimized ordering order_values <- x@result[[orderBy]][i] j <- order(order_values, decreasing = decreasing) ## Efficient data frame construction len <- lengths(gs2val) total_len <- sum(len) gs2val.df <- data.frame( category = rep(nn, times = len), color = rep(x[i, fill], times = len), value = unlist(gs2val, use.names = FALSE) ) colnames(gs2val.df)[2] <- fill gs2val.df$category <- factor(gs2val.df$category, levels = nn[j]) label_func <- default_labeller(label_format) if (is.function(label_format)) { label_func <- label_format } check_installed('ggridges', 'for `ridgeplot()`.') ggplot( gs2val.df, aes(x = .data[["value"]], y = .data[["category"]], fill = .data[[fill]]) ) + ggridges::geom_density_ridges(stat = stat) + set_enrichplot_color(type = "fill", name = fill, transform = 'log10') + scale_y_discrete(labels = label_func) + xlab(NULL) + ylab(NULL) + theme_dose() } ================================================ FILE: R/ssplot.R ================================================ #' @rdname ssplot #' @exportMethod ssplot setMethod( "ssplot", signature(x = "enrichResult"), function(x, showCategory = 30, ...) { ssplot.enrichResult(x, showCategory = showCategory, ...) } ) #' @rdname ssplot #' @exportMethod ssplot setMethod( "ssplot", signature(x = "gseaResult"), function(x, showCategory = 30, ...) { ssplot.enrichResult(x, showCategory = showCategory, ...) } ) #' @rdname ssplot #' @exportMethod ssplot setMethod( "ssplot", signature(x = "compareClusterResult"), function(x, showCategory = 30, ...) { ssplot.compareClusterResult(x, showCategory = showCategory, ...) } ) #' @rdname ssplot #' @param drfun The function used for dimension reduction, #' e.g. `stats::cmdscale` (the default), `vegan::metaMDS`, or `ape::pcoa`. #' @param dr.params list, the parameters of `tidydr::dr`. #' @inheritParams emapplot #' @param ... additional parameters #' #' Additional plotting parameters are inherited from [emapplot()]. #' @importFrom tidydr theme_dr ssplot.enrichResult <- function( x, showCategory = 30, drfun = NULL, dr.params = list(), #group = TRUE, node_label = "group", ... ) { if (is.null(drfun)) { drfun = stats::cmdscale dr.params = list(eig = TRUE) } if (is.character(drfun)) { drfun <- eval(parse(text = drfun)) } drResult <- get_drResult( x = x, showCategory = showCategory, drfun = drfun, dr.params = dr.params ) coords <- drResult$drdata[, c(1, 2)] colnames(coords) <- c("x", "y") rownames(coords) <- attr(drResult$data, "Labels") p <- emapplot( x = x, showCategory = showCategory, #group = group, node_label = node_label, ... ) ## Set axis label according to drfun p <- adj_axis(p = p, drResult = drResult) p + theme_dr() } #' @rdname ssplot #' @importFrom ggplot2 theme_classic #' @importFrom ggplot2 coord_equal # @param cex_pie2axis Adjust the relative size of the pie chart on the axes (default `0.0125`). #' @importFrom stats setNames ssplot.compareClusterResult <- function( x, showCategory = 30, #split = NULL, pie = "equal", drfun = NULL, #cex_pie2axis = 0.0125, dr.params = list(), node_label = "group", ... ) { if (is.null(drfun)) { drfun = stats::cmdscale dr.params = list(eig = TRUE) } if (is.character(drfun)) { drfun <- eval(parse(text = drfun)) } split = NULL drResult <- get_drResult( x = x, showCategory = showCategory, split = split, pie = pie, drfun = drfun, dr.params = dr.params ) coords <- drResult$drdata[, c(1, 2)] colnames(coords) <- c("x", "y") rownames(coords) <- attr(drResult$data, "Labels") p <- emapplot( x, showCategory = showCategory, coords = coords, split = split, pie = pie, #with_edge = with_edge, #cex_pie2axis = cex_pie2axis, #group = group, node_label = node_label, ... ) ## Set axis label according to the method parameter p <- adj_axis(p = p, drResult = drResult) p + theme_dr() } #' Get a distance matrix #' #' @param x enrichment result. #' @param showCategory number of enriched terms to display. #' @param split separate result by 'category' variable. #' @param pie proportion of clusters in the pie chart. #' @noRd build_dist <- function(x, showCategory, split = NULL, pie = NULL) { sim = get_pairwise_sim( x = x, showCategory = showCategory, split = split, pie = pie ) # ensure symmetry if (!isSymmetric(sim)) { sim <- (sim + t(sim)) / 2 } # clamp to [0,1] sim[is.na(sim)] <- 0 sim <- pmin(pmax(sim, 0), 1) # avoid exact 1 for off-diagonal entries (some DR methods may fail) eps <- .Machine$double.eps diag(sim) <- 1 offdiag_idx <- row(sim) != col(sim) sim[offdiag_idx & sim >= 1] <- 1 - eps stats::as.dist(1 - sim) } #' Get a similarity matrix #' #' @param x enrichment result. #' @param showCategory number of enriched terms to display. #' @param split separate result by 'category' variable. #' @param pie proportion of clusters in the pie chart. #' @noRd get_pairwise_sim <- function(x, showCategory, split = NULL, pie = NULL) { if (inherits(x, "compareClusterResult")) { ## Optimized fortify call for large datasets y <- fortify( model = x, showCategory = showCategory, includeAll = TRUE, split = split ) y$Cluster <- sub("\n.*", "", y$Cluster) ## Optimized pie category preparation pie_data <- prepare_pie_category(y, pie = pie) keep <- rownames(pie_data) } else { n <- update_n(x, showCategory) if (is.numeric(n)) { keep <- seq_len(min(n, nrow(x@result))) } else { keep <- match(n, rownames(x@termsim)) keep <- keep[!is.na(keep)] } } if (length(keep) == 0) { yulab_abort("no enriched term found (no rows selected by showCategory).", class = "no_terms_error") } ## Optimized termsim filling fill_termsim(x, keep) } #' Adjust axis label according to the dimension reduction method #' #' @param p ggplot2 object #' @param drs dimension reduction result #' @noRd adj_axis <- function(p, drResult) { title = NULL eigenvalue <- drResult$eigenvalue if (!is.null(eigenvalue) && length(eigenvalue) >= 2) { total <- sum(eigenvalue) if (total == 0) { total <- 1 } xlab = paste0( "Dimension1 (", format(100 * eigenvalue[1] / total, digits = 4), "%)" ) ylab = paste0( "Dimension2 (", format(100 * eigenvalue[2] / total, digits = 4), "%)" ) } else { xlab = "Dimension1" ylab = "Dimension2" if (!is.null(drResult$stress)) { title <- paste0("stress = ", drResult$stress) } } p <- p + labs(x = xlab, y = ylab, title = title) return(p) } #' Get the result of dimension reduction #' #' @param x enrichment result. #' @param showCategory number of enriched terms to display. #' @param split separate result by 'category' variable. #' @param pie proportion of clusters in the pie chart. #' @param drfun The function used for dimension reduction. #' @param dr.params list, the parameters of tidydr::dr. #' @importFrom rlang check_installed #' @noRd get_drResult <- function( x, showCategory, split = NULL, pie = NULL, drfun, dr.params ) { ## Input validation check_input(x, arg_name = "x") check_input(showCategory, arg_name = "showCategory") ## Optimized distance matrix building distance_mat <- build_dist( x = x, showCategory = showCategory, split = split, pie = pie ) check_installed('tidydr', 'for `get_drResult()`') ## Optimized error handling drResult <- tryCatch({ do.call(tidydr::dr, c(list(data = distance_mat, fun = drfun), dr.params)) }, error = function(e) { yulab_warn("dimensionality reduction failed with provided drfun; falling back to stats::cmdscale", class = "dr_fallback_warning") tryCatch({ tidydr::dr(distance_mat, stats::cmdscale, eig = TRUE) }, error = function(e2) { yulab_abort("dimensionality reduction failed (both provided method and fallback)", class = "dr_failure_error") }) }) if (is.null(drResult$drdata)) { yulab_warn("Wrong drfun parameter or unsupported dimensionality reduction method; using stats::cmdscale", class = "dr_parameter_warning") drResult <- tidydr::dr(distance_mat, stats::cmdscale, eig = TRUE) } return(drResult) } ================================================ FILE: R/treeplot.R ================================================ #' Tree plot for enrichment results #' #' Creates hierarchical tree visualization of enriched terms based on similarity #' #' @rdname treeplot #' @exportMethod treeplot setMethod("treeplot", signature(x = "enrichResult"), function(x, ...) { treeplot_internal(x, size_var = "Count", ...) }) #' @rdname treeplot #' @exportMethod treeplot setMethod("treeplot", signature(x = "gseaResult"), function(x, ...) { treeplot_internal(x, size_var = "setSize", ...) }) #' @rdname treeplot #' @exportMethod treeplot setMethod("treeplot", signature(x = "compareClusterResult"), function(x, ...) { treeplot_compareCluster(x, ...) }) #' @rdname treeplot #' @param showCategory number of enriched terms to display #' @param color variable to color nodes, e.g. 'p.adjust', 'pvalue', or 'qvalue' #' @param size_var variable for node size, e.g. 'Count' (for enrichResult) or 'setSize' (for gseaResult) #' @param nCluster number of clusters for tree cutting #' @param cluster_method hierarchical clustering method #' @param label_format wrap length for labels or custom formatting function #' @param fontsize_tiplab font size for tip labels #' @param fontsize_cladelab font size for clade labels #' @param group_color vector of colors for groups #' @param extend extend length for clade labels #' @param hilight whether to highlight clades #' @param align alignment for highlight rectangles #' @param hexpand expand x limits by amount of xrange * hexpand #' @param tiplab_offset offset for tip labels #' @param cladelab_offset offset for clade labels #' @return ggplot2 object representing the tree plot #' @importFrom ggtree ggtree geom_tiplab geom_tippoint groupClade geom_cladelab geom_hilight #' @importFrom ggplot2 scale_size_continuous guides guide_legend guide_colorbar #' @importFrom stats hclust cutree as.dist treeplot_internal <- function( x, showCategory = 30, color = "p.adjust", size_var = c("Count", "setSize"), nCluster = 5, cluster_method = "ward.D", label_format = 30, fontsize_tiplab = 4, fontsize_cladelab = 4, group_color = NULL, extend = 0.3, hilight = TRUE, align = "both", hexpand = 0.1, tiplab_offset = 0.2, cladelab_offset = 1 ) { # Input validation if (!inherits(x, c("enrichResult", "gseaResult", "compareClusterResult"))) { stop( "x must be an enrichResult, gseaResult, or compareClusterResult object" ) } # Get selected categories n <- update_n(x, showCategory) if (is.numeric(n)) { keep <- seq_len(n) } else { keep <- match(n, rownames(x@termsim)) } if (length(keep) == 0) { stop("no enriched term found...") } # Prepare similarity matrix termsim2 <- fill_termsim(x, keep) # Hierarchical clustering hc <- hclust(as.dist(1 - termsim2), method = cluster_method) clus <- cutree(hc, nCluster) # Prepare data for plotting size_var <- intersect(size_var, colnames(x[]))[1] if (is.na(size_var)) { stop("size_var not found in enrichment result") } # Extract columns and ensure they exist d <- x[keep, c(color, size_var)] # Handle case where columns are collapsed (e.g. tibble with duplicate columns) if (ncol(d) == 1 && color == size_var) { d <- data.frame(d, d) names(d) <- c(color, size_var) } # Determine safe size column name size_col <- "size" if (color == "size") { size_col <- "size_value" } # Rename size column names(d)[2] <- size_col # Add label column from cluster names d$label <- names(clus) # Select columns safely d <- d[, c("label", color, size_col)] # Create tree plot p <- create_tree_plot( hc = hc, clus = clus, data = d, label_format = label_format, fontsize_tiplab = fontsize_tiplab, fontsize_cladelab = fontsize_cladelab, group_color = group_color, extend = extend, hilight = hilight, align = align, color_var = color, size_var = size_col, tiplab_offset = tiplab_offset, cladelab_offset = cladelab_offset ) # Add styling p <- p + scale_size_continuous( name = size_var, range = c(3, 8) ) + ggtree::hexpand(ratio = hexpand) + guides( size = guide_legend(order = 1), color = guide_colorbar(order = 2) ) return(p) } #' Tree plot for compareClusterResult objects #' #' @param x compareClusterResult object #' @param showCategory number of enriched terms to display #' @param color variable to color nodes #' @param nCluster number of clusters #' @param cluster_method hierarchical clustering method #' @param label_format label formatting #' @param fontsize_tiplab tip label font size #' @param fontsize_cladelab clade label font size #' @param group_color group colors #' @param extend extend length #' @param hilight whether to highlight clades #' @param align highlight alignment #' @param hexpand expand x limits #' @param tiplab_offset tip label offset #' @param cladelab_offset clade label offset #' @param pie proportion method for pie charts ("equal" or "Count") #' @param cluster_panel panel type for clusters ("pie", "heatMap", or "dotplot") #' @param legend_n number of legend items for pie charts #' @param colnames_angle angle for column names in heatmaps #' @importFrom ggtree gheatmap #' @importFrom scatterpie geom_scatterpie geom_scatterpie_legend #' @importFrom ggnewscale new_scale_fill new_scale_colour #' @noRd treeplot_compareCluster <- function( x, showCategory = 30, color = "p.adjust", nCluster = 5, cluster_method = "ward.D", label_format = 30, fontsize_tiplab = 4, fontsize_cladelab = 4, group_color = NULL, extend = 0.3, hilight = TRUE, align = "both", hexpand = 0.1, tiplab_offset = 0.2, cladelab_offset = 1, pie = "equal", cluster_panel = "pie", legend_n = 3, colnames_angle = 0 ) { # Prepare data for compareClusterResult y <- fortify( x, showCategory = showCategory, includeAll = TRUE, split = NULL ) y$Cluster <- sub("\n.*", "", y$Cluster) if ("core_enrichment" %in% colnames(y)) { y$geneID <- y$core_enrichment } # Prepare cluster matrix ID_Cluster_mat <- prepare_pie_category(y, pie = pie) # Get selected categories keep <- rownames(ID_Cluster_mat) if (length(keep) == 0) { stop("no enriched term found...") } # Prepare similarity matrix termsim2 <- fill_termsim(x, keep) # Hierarchical clustering hc <- hclust(as.dist(1 - termsim2), method = cluster_method) clus <- cutree(hc, nCluster) # Prepare data for plotting merged_ggData <- merge_compareClusterResult(y) rownames(merged_ggData) <- merged_ggData$Description d <- data.frame( label = names(clus), count = merged_ggData[names(clus), "Count"] ) # Create base tree plot p <- create_tree_plot( hc = hc, clus = clus, data = d, label_format = label_format, fontsize_tiplab = fontsize_tiplab, fontsize_cladelab = fontsize_cladelab, group_color = group_color, extend = extend, hilight = hilight, align = align, color_var = color, tiplab_offset = tiplab_offset, cladelab_offset = cladelab_offset, add_tippoint = FALSE # Don't add tip points for compareCluster ) # Add cluster panel based on type p <- add_cluster_panel( p = p, cluster_panel = cluster_panel, ID_Cluster_mat = ID_Cluster_mat, x = x, color = color, legend_n = legend_n, colnames_angle = colnames_angle, hexpand = hexpand ) return(p) } #' Add cluster panel to tree plot #' #' @param p tree plot #' @param cluster_panel panel type #' @param ID_Cluster_mat cluster matrix #' @param x compareClusterResult object #' @param color color variable #' @param legend_n legend items count #' @param colnames_angle column names angle #' @param hexpand expand ratio #' @importFrom rlang sym #' @noRd add_cluster_panel <- function( p, cluster_panel, ID_Cluster_mat, x, color, legend_n, colnames_angle, hexpand ) { p_data <- as.data.frame(p$data) p_data <- p_data[which(!is.na(p_data$label)), ] rownames(p_data) <- p_data$label p_data <- p_data[rownames(ID_Cluster_mat), ] if (cluster_panel == "pie") { # Add pie chart panel ID_Cluster_mat$radius <- sqrt(p_data$count / sum(p_data$count)) ID_Cluster_mat$x <- p_data$x ID_Cluster_mat$y <- p_data$y ID_Cluster_mat$node <- p_data$node p <- p + ggnewscale::new_scale_fill() + scatterpie::geom_scatterpie( aes(x = .data$x, y = .data$y, r = .data$radius), data = ID_Cluster_mat, cols = colnames(ID_Cluster_mat)[1:(ncol(ID_Cluster_mat) - 4)], color = NA ) + scatterpie::geom_scatterpie_legend( ID_Cluster_mat$radius, x = 0.8, y = 0.1, n = legend_n, labeller = function(x) round(sum(p_data$count) * x^2) ) + labs(fill = "Cluster") + coord_equal() } else if (cluster_panel == "heatMap") { # Add heatmap panel heatMapData <- as.data.frame(x) heatMapData$Cluster <- as.character(heatMapData$Cluster) heatMapData <- heatMapData[ heatMapData$Cluster %in% colnames(ID_Cluster_mat), ] heatMapData <- heatMapData[ heatMapData$Description %in% rownames(ID_Cluster_mat), ] for (i in seq_len(nrow(heatMapData))) { ID_Cluster_mat[ heatMapData[i, "Description"], heatMapData[i, "Cluster"] ] <- heatMapData[i, color] } p <- p + ggnewscale::new_scale_fill() + ggtree::gheatmap( ID_Cluster_mat, colnames_angle = colnames_angle, width = 0.5 ) + set_enrichplot_color( type = "fill", transform = "log10", name = color ) } else if (cluster_panel == "dotplot") { # Add dotplot panel dotdata <- as.data.frame(x) pData <- as.data.frame(p$data) paths <- pData$label[order(pData$y, decreasing = TRUE)] paths <- paths[!is.na(paths)] dotdata <- dotdata[dotdata$Description %in% paths, ] dotdata <- dplyr::select(dotdata, .data$Description, dplyr::everything()) p <- p + ggnewscale::new_scale_colour() + ggtreeExtra::geom_fruit( data = dotdata, geom = geom_point, mapping = aes( x = .data$Cluster, y = .data$Description, size = .data$Count, color = .data[[color]] ), pwidth = 0.06 * ncol(ID_Cluster_mat), axis.params = list( axis = "x", text.size = 3, line.alpha = 0, text.angle = colnames_angle ) ) + set_enrichplot_color(transform = "log10", name = color) } return(p + ggtree::hexpand(ratio = hexpand)) } #' Create tree plot from clustering results #' #' @param hc hierarchical clustering result #' @param clus cluster assignments #' @param data node data #' @param label_format label formatting #' @param fontsize_tiplab tip label font size #' @param fontsize_cladelab clade label font size #' @param group_color group colors #' @param extend extend length #' @param hilight whether to highlight #' @param align highlight alignment #' @param color_var color variable name #' @param tiplab_offset tip label offset #' @param cladelab_offset clade label offset #' @param add_tippoint whether to add tip points (default: TRUE) #' @noRd #' @importFrom ggfun %<+% create_tree_plot <- function( hc, clus, data, label_format, fontsize_tiplab, fontsize_cladelab, group_color, extend, hilight, align = 'left', color_var, size_var = 'size', tiplab_offset = 0.2, cladelab_offset, add_tippoint = TRUE ) { # Set colors if (is.null(group_color)) { n_clusters <- length(unique(clus)) group_color <- scales::hue_pal()(n_clusters) } # Create base tree p <- ggtree(hc, hang = -1, branch.length = "none") # Group nodes dat <- data.frame( name = names(clus), cls = paste0("cluster_", as.numeric(clus)) ) grp <- apply(table(dat), 2, function(x) names(x[x == 1])) clades <- vapply(grp, \(nodes) ggtree::MRCA(p, nodes), numeric(1)) p <- groupClade(p, clades, "group") + aes(color = .data$group) + scale_color_manual( values = c(group_color, "white"), breaks = names(clades) ) # Add tip points and labels p <- p %<+% data # Add clade labels and highlights if (hilight) { p <- add_clade_labels( p, clades, label_format, fontsize_cladelab, group_color, extend, align, offset = cladelab_offset ) } if (add_tippoint) { p <- p + ggnewscale::new_scale_colour() + geom_tippoint(aes( color = .data[[color_var]], size = .data[[size_var]] )) if (color_var %in% c("pvalue", "qvalue", "p.adjust")) { p <- p + set_enrichplot_color(transform = 'log10') } else { p <- p + set_enrichplot_color( colors = rev(get_enrichplot_color(3)), ) } } p <- p + geom_tiplab( offset = tiplab_offset, hjust = 0, size = fontsize_tiplab ) return(p) } #' Add clade labels and highlights to tree plot #' #' @param p tree plot #' @param clades clade definitions #' @param label_format label formatting #' @param fontsize font size #' @param group_color group colors #' @param extend extend length #' @param align highlight alignment #' @importFrom ggplot2 scale_fill_manual #' @noRd add_clade_labels <- function( p, clades, label_format, fontsize, group_color, extend, align, offset ) { # Prepare clade label data df <- data.frame( node = as.numeric(clades), labels = names(clades), cluster = factor(names(clades)) ) # Get the tree data to access tip labels pdata <- as.data.frame(p$data) pdata <- pdata[!is.na(pdata$label), ] # Create the required data structure for get_wordcloud wordcloud_data <- data.frame( name = pdata$label, color2 = pdata$group ) # Generate meaningful cluster labels from tip labels cluster_labels <- sapply(names(clades), function(cluster_name) { get_wordcloud(cluster_name, wordcloud_data, nWords = 4) }) df$labels <- cluster_labels # Apply label formatting label_func <- default_labeller(label_format) if (is.function(label_format)) { label_func <- label_format } df$labels <- label_func(df$labels) df$color <- group_color # Add clade labels and highlights p <- p + ggnewscale::new_scale_colour() + geom_cladelab( data = df, mapping = aes( node = !!sym('node'), label = !!sym('labels'), color = !!sym('cluster') ), textcolor = "black", extend = extend, show.legend = FALSE, fontsize = fontsize, offset = offset ) + scale_color_manual(values = group_color, guide = 'none') + geom_hilight( data = df, mapping = aes(node = !!sym('node'), fill = !!sym('cluster')), show.legend = FALSE, align = align ) + scale_fill_manual(values = group_color, guide = 'none') return(p) } #' Fill the upper triangular matrix completely #' #' @param x enrichment result #' @param keep selected categories #' @return filled similarity matrix #' @noRd fill_termsim <- function(x, keep) { termsim <- x@termsim[keep, keep] termsim[which(is.na(termsim))] <- 0 termsim2 <- termsim + t(termsim) diag(termsim2) <- 1 return(termsim2) } ================================================ FILE: R/upsetplot.R ================================================ #' Upsetplot #' #' Upsetplot #' #' @rdname upsetplot-methods #' @aliases upsetplot,enrichResult,ANY-method #' @param n number of categories to be plotted #' @param ... additional parameters #' @author Guangchuang Yu #' @exportMethod upsetplot #' @examples #' library(DOSE) #' data(geneList) #' de <- names(geneList)[1:100] #' x <- enrichDO(de) #' upsetplot(x, 8) setMethod("upsetplot", signature(x="enrichResult"), function(x, n=10, ...) { upsetplot.enrichResult(x, n, ...) }) #' @rdname upsetplot-methods #' @aliases upsetplot,gseaResult #' @exportMethod upsetplot setMethod("upsetplot", signature(x="gseaResult"), function(x, n=10, ...) { upsetplot.gseaResult(x, n, ...) }) #' @importFrom rlang check_installed upsetplot.enrichResult <- function(x, n=10, ...) { df <- as.data.frame(x) id <- df$ID[1:n] des <- df$Description[1:n] glist <- geneInCategory(x)[id] names(glist) <- des ## g <- unique(unlist(glist)) ## dat <- matrix(0, nrow=length(g), ncol=length(id)) ## rownames(dat) <- g ## for (i in 1:length(id)) { ## dat[glist[[i]], i] <- 1 ## } ## colnames(dat) <- des ## ## cols <- ggtree:::color_scale("red", "blue") ## ## pv <- df$pvalue[1:n] ## ## idx <- sapply(pv, function(p) DOSE:::getIdx(p, min(pv), max(pv))) ## ## sets.bar.color = cols[idx], ## ## UpSetR <- "UpSetR" ## ## require(UpSetR, character.only = TRUE) ## ## upset <- eval(parse(text="upset")) ## upsetR::upset(as.data.frame(dat), nsets=n, ...) d <- list2df(glist) check_installed('tibble', 'for `upsetplot()`.') check_installed('ggupset', 'for `upsetplot()`.') res <- tibble::tibble(Description = split(d[,1], d[,2])) ggplot(res, aes(x = .data$Description)) + geom_bar() + theme_dose(font.size = 12) + xlab(NULL) + ylab(NULL) + ggupset::scale_x_upset(order_by = "freq") } #' @importFrom ggplot2 geom_violin #' @importFrom ggplot2 geom_jitter #' @importFrom rlang check_installed upsetplot.gseaResult <- function(x, n = 10, type = "boxplot", ...) { n <- update_n(x, n) geneSets <- extract_geneSets(x, n) ## foldChange <- fc_readable(x, x@geneList) d <- list2df(geneSets) category <- split(d[,1], d[, 2]) check_installed('tibble', 'for `upsetplot()`.') y <- tibble::tibble(Description = category, gene = names(category), foldChange = x@geneList[names(category)]) if (type == "boxplot") { ly_dist <- geom_boxplot() } else { ly_dist <- geom_violin() } check_installed('ggupset', 'for `upsetplot()`.') ggplot(y, aes(x = .data$Description, y = .data$foldChange)) + ly_dist + geom_jitter(width = .2, alpha = .6) + theme_dose(font.size = 12) + xlab(NULL) + ylab(NULL) + ggupset::scale_x_upset(order_by = "degree") } ## @rdname upsetplot-methods ## @aliases upsetplot,compareClusterResult ## @exportMethod upsetplot #setMethod("upsetplot", signature(x="compareClusterResult"), # function(x, n=10, ...) { # upsetplot.compareClusterResult(x, n, ...) # }) upsetplot.compareClusterResult <- function(x, n, ...) { x <- append_intersect(x) ## ggplot(x, aes(-10*log10(p.adjust), Description)) + geom_point() + facet_grid(set~., scales="free") ggplot(x, aes(x = .data$Cluster, y = .data$Description), showCategory=n) + geom_point(aes(size = -10 * log10(.data$p.adjust), color = .data$Cluster)) + facet_grid(intersect ~ ., scales = "free", space = 'free') + guides(color = "none") + theme_dose(font.size = 12) + theme(strip.text = element_text(size = 14)) + xlab(NULL) + ylab(NULL) } ================================================ FILE: R/volplot.R ================================================ #' @rdname volplot #' @exportMethod volplot #' @author Guangchuang Yu setMethod("volplot", signature(x = "enrichResult"), function(x, color = "zScore", xintercept = 1, yintercept = 2, showCategory = 5, label_format = 30, ...) { volplot.enrichResult(x = x, color = color, xintercept = xintercept, yintercept = yintercept, showCategory = showCategory, label_format = label_format, ...) }) #' @rdname volplot #' @param font.size font size for `theme_dose()` #' @param size font size to label selected categories specified by showCategory volplot.enrichResult <- function(x, color = "zScore", xintercept = 1, yintercept = 2, showCategory=5, label_format = 30, font.size=12, size = 5) { if (yintercept < 1) yintercept = -log10(yintercept) p <- ggplot(x@result, aes(x=log2(.data$FoldEnrichment), y= -log10(.data$p.adjust))) + geom_point(aes(color=.data[[color]])) + geom_hline(yintercept = yintercept, lty='dashed') + geom_vline(xintercept = xintercept, lty='dashed') p <- p + set_enrichplot_color(type = "color", reverse = FALSE) + theme_dose(font.size) if (is.numeric(showCategory)) { topN <- showCategory d <- dplyr::arrange(x@result, dplyr::desc(.data[[color]])) showCategory <- d$Description[1:topN] } label_func <- .label_format(label_format) p <- p + ggrepel::geom_text_repel(aes(label=label_func(.data$Description)), data = function(d) dplyr::filter(d, .data$Description %in% showCategory), size = size ) p <- p + labs(x=bquote(paste(log[2], "(FoldEnrichment)")), y = bquote(paste(-log[10], "(p.adjust)")) ) return(p) } ================================================ FILE: R/wordcloud.R ================================================ #' Use wordcloud algorithm to get group tags #' #' @param cluster a cluster name #' @param node_data the data section of the ggplot object, #' which contains clustering information. #' @param nWords the number of words in the cluster tags #' @importFrom utils head #' @noRd get_wordcloud <- function(cluster, node_data, nWords = 4) { cluster_terms <- node_data$name[node_data$color2 == cluster] if (length(cluster_terms) == 0) { return(cluster) } words <- cluster_terms |> tolower() |> gsub(" in ", " ", x = _) |> gsub(" [0-9]+ ", " ", x = _) |> gsub("^[0-9]+ ", "", x = _) |> gsub(" [0-9]+$", "", x = _) |> gsub(" [a-z] ", " ", x = _) |> gsub("^[a-z] ", "", x = _) |> gsub(" [a-z]$", "", x = _) |> gsub(" / ", " ", x = _) |> gsub(" and ", " ", x = _) |> gsub(" of ", " ", x = _) |> gsub(",", " ", x = _) |> gsub(" - ", " ", x = _) |> gsub("\\s+", " ", x = _) |> # multiple spaces to single space trimws() # remove leading/trailing whitespace # Split into words and calculate frequencies all_words <- unlist(strsplit(words, "\\s+")) if (length(all_words) == 0) { return(cluster) } word_freq <- table(all_words) word_freq <- word_freq[order(word_freq, decreasing = TRUE)] # Remove common stop words stop_words <- c( "the", "and", "for", "with", "via", "by", "to", "a", "an", "in", "of", "on", "at" ) meaningful_words <- names(word_freq)[ !tolower(names(word_freq)) %in% stop_words ] # Get top nWords meaningful words if (length(meaningful_words) > 0) { top_words <- head(meaningful_words, nWords) # Consider word position for ordering (optional enhancement) word_positions <- calculate_word_positions(cluster_terms, top_words) if (!is.null(word_positions)) { top_words <- word_positions } return(paste(top_words, collapse = " ")) } else { # Fallback: use most frequent words regardless top_words <- head(names(word_freq), nWords) return(paste(top_words, collapse = " ")) } } #' Calculate word positions to improve label ordering #' #' @param terms vector of terms #' @param candidate_words candidate words for the label #' @return ordered words based on position #' @noRd calculate_word_positions <- function(terms, candidate_words) { if (length(terms) == 0 || length(candidate_words) == 0) { return(NULL) } # Split all terms into words all_term_words <- strsplit(tolower(terms), "\\s+") # Calculate average position for each candidate word word_ranks <- list() for (word in candidate_words) { positions <- c() for (term_words in all_term_words) { word_idx <- which(term_words == tolower(word)) if (length(word_idx) > 0) { positions <- c(positions, word_idx) } } if (length(positions) > 0) { word_ranks[[word]] <- mean(positions) } else { word_ranks[[word]] <- Inf # Word not found in any term } } # Order words by their average position if (length(word_ranks) > 0) { sorted_words <- names(sort(unlist(word_ranks))) return(sorted_words) } return(NULL) } ================================================ FILE: R/zzz.R ================================================ #' @importFrom yulab.utils yulab_msg .onAttach <- function(libname, pkgname) { options(check.tbl_tree.verbose = FALSE) packageStartupMessage(yulab.utils::yulab_msg(pkgname)) } ================================================ FILE: README.Rmd ================================================ --- output: md_document: variant: gfm html_preview: false --- # `r packageDescription("enrichplot")$Title` ```{r echo=FALSE, results="hide", message=FALSE} library("badger") ``` `r badge_bioc_release("enrichplot", "green")` `r badge_devel("guangchuangyu/enrichplot", "green")` [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/enrichplot.svg)](https://www.bioconductor.org/packages/devel/bioc/html/enrichplot.html#since) `r badge_download_bioc("enrichplot")` `r badge_bioc_download("enrichplot", "total", "blue")` `r badge_bioc_download("enrichplot", "month", "blue")` [![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![platform](http://www.bioconductor.org/shields/availability/devel/enrichplot.svg)](https://www.bioconductor.org/packages/devel/bioc/html/enrichplot.html#archives) [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/treeio.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/treeio/) [![Last-changedate](https://img.shields.io/badge/last%20change-`r gsub('-', '--', Sys.Date())`-green.svg)](https://github.com/GuangchuangYu/treeio/commits/master) ```{r comment="", echo=FALSE, results='asis'} cat(packageDescription('enrichplot')$Description) ``` For details, please visit . ## :writing_hand: Authors Guangchuang YU School of Basic Medical Sciences, Southern Medical University ## :arrow_double_down: Installation Get the released version from Bioconductor: ```r ## try http:// if https:// URLs are not supported if (!requireNamespace("BiocManager", quietly=TRUE)) install.packages("BiocManager") ## BiocManager::install("BiocUpgrade") ## you may need this BiocManager::install("enrichplot") ``` Or the development version from github: ```r ## install.packages("remotes") remotes::install_github("YuLab-SMU/enrichplot") ## or ## install.packages("yulab.utils") yulab.utils::install_zip_gh("YuLab-SMU/enrichplot") ``` ## :sparkling_heart: Contributing We welcome any contributions! By participating in this project you agree to abide by the terms outlined in the [Contributor Code of Conduct](CONDUCT.md). ================================================ FILE: README.md ================================================ # Visualization of Functional Enrichment Result [![](https://img.shields.io/badge/release%20version-1.30.5-green.svg)](https://www.bioconductor.org/packages/enrichplot) [![](https://img.shields.io/badge/devel%20version-1.31.5-green.svg)](https://github.com/guangchuangyu/enrichplot) [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/enrichplot.svg)](https://www.bioconductor.org/packages/devel/bioc/html/enrichplot.html#since) [![download](http://www.bioconductor.org/shields/downloads/release/enrichplot.svg)](https://bioconductor.org/packages/stats/bioc/enrichplot) [![](https://img.shields.io/badge/download-1256962/total-blue.svg)](https://bioconductor.org/packages/stats/bioc/enrichplot) [![](https://img.shields.io/badge/download-38757/month-blue.svg)](https://bioconductor.org/packages/stats/bioc/enrichplot) [![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![platform](http://www.bioconductor.org/shields/availability/devel/enrichplot.svg)](https://www.bioconductor.org/packages/devel/bioc/html/enrichplot.html#archives) [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/treeio.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/treeio/) [![Last-changedate](https://img.shields.io/badge/last%20change-2026--04--24-green.svg)](https://github.com/GuangchuangYu/treeio/commits/master) The ‘enrichplot’ package provides visualization methods for interpreting functional enrichment results from ORA or GSEA analyses. It is designed to work with the ‘clusterProfiler’ ecosystem and builds on ‘ggplot2’ for flexible and extensible graphics. For details, please visit . ## :writing_hand: Authors Guangchuang YU School of Basic Medical Sciences, Southern Medical University ## :arrow_double_down: Installation Get the released version from Bioconductor: ``` r ## try http:// if https:// URLs are not supported if (!requireNamespace("BiocManager", quietly=TRUE)) install.packages("BiocManager") ## BiocManager::install("BiocUpgrade") ## you may need this BiocManager::install("enrichplot") ``` Or the development version from github: ``` r ## install.packages("remotes") remotes::install_github("YuLab-SMU/enrichplot") ## or ## install.packages("yulab.utils") yulab.utils::install_zip_gh("YuLab-SMU/enrichplot") ``` ## :sparkling_heart: Contributing We welcome any contributions! By participating in this project you agree to abide by the terms outlined in the [Contributor Code of Conduct](CONDUCT.md). ================================================ FILE: TODO.md ================================================ # TODO LIST + [x] manhattan plot for enriched result - figure 1 of + [ ] Circos plot for expression prifile and pathway annotation - Fig 2 of - maybe a cartisian coordination version, i.e. a heatmap with a dot table to indicate the pathways belong. + [x] plot enriched terms as a tree - hc(1-sim), where sim is calculated by GOSemSim, and visualize by ggtree - label clade with representative words + [ ] plot gene expression profile by PCA (or other methods) and label clusters with representative words ================================================ FILE: enrichplot.Rproj ================================================ Version: 1.0 RestoreWorkspace: No SaveWorkspace: No AlwaysSaveHistory: Default EnableCodeIndexing: Yes UseSpacesForTab: Yes NumSpacesForTab: 4 Encoding: UTF-8 RnwWeave: knitr LaTeX: pdfLaTeX AutoAppendNewline: Yes StripTrailingWhitespace: Yes BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source PackageRoxygenize: rd,collate,namespace ================================================ FILE: man/as.data.frame.compareClusterResult.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data_utils.R \name{as.data.frame.compareClusterResult} \alias{as.data.frame.compareClusterResult} \title{Convert compareClusterResult to data frame} \usage{ \method{as.data.frame}{compareClusterResult}(x, ...) } \arguments{ \item{x}{compareClusterResult object} \item{...}{additional parameters} } \value{ data frame } \description{ Convert compareClusterResult to data frame } ================================================ FILE: man/autofacet.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot_utils.R \name{autofacet} \alias{autofacet} \title{Plotting utility functions for enrichplot package} \usage{ autofacet(by = "row", scales = "free", levels = NULL) } \arguments{ \item{by}{one of 'row' or 'column'} \item{scales}{whether 'fixed' or 'free'} \item{levels}{set facet levels} } \value{ a ggplot object } \description{ This file contains plotting and visualization helper functions for enrichplot Automatically split barplot or dotplot into several facets } ================================================ FILE: man/barplot.enrichResult.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/barplot.R \name{barplot.enrichResult} \alias{barplot.enrichResult} \title{barplot} \usage{ \method{barplot}{enrichResult}( height, x = "Count", color = "p.adjust", showCategory = 8, font.size = 12, title = "", label_format = 30, ... ) } \arguments{ \item{height}{enrichResult object} \item{x}{one of 'Count' and 'GeneRatio'} \item{color}{one of 'pvalue', 'p.adjust' and 'qvalue'} \item{showCategory}{number of categories to display or a vector of terms.} \item{font.size}{font size} \item{title}{plot title} \item{label_format}{a numeric value sets wrap length, alternatively a custom function to format axis labels. by default wraps names longer than 30 characters} \item{...}{additional parameters} } \value{ ggplot object } \description{ Barplot of enrichResult } \details{ Barplot of enrichResult } \examples{ library(DOSE) data(geneList) de <- names(geneList)[1:100] x <- enrichDO(de) barplot(x) # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. barplot(x, showCategory = 10) categories <- c("urinary bladder cancer", "bronchiolitis obliterans", "aortic aneurysm", "esophageal cancer") barplot(x, showCategory = categories) } ================================================ FILE: man/cnetplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnetplot.R \name{cnetplot.enrichResult} \alias{cnetplot.enrichResult} \alias{cnetplot.gseaResult} \alias{cnetplot.compareClusterResult} \title{Category-Gene-Network Plot} \usage{ \method{cnetplot}{enrichResult}( x, layout = igraph::layout_with_kk, showCategory = 5, color_category = "#E5C494", size_category = 1, color_item = "#B3B3B3", size_item = 1, color_edge = "grey", size_edge = 0.5, categorySizeBy = ~itemNum, node_label = "all", foldChange = NULL, fc_threshold = NULL, hilight = "none", hilight_alpha = 0.3, ... ) \method{cnetplot}{gseaResult}( x, layout = igraph::layout_with_kk, showCategory = 5, color_category = "#E5C494", size_category = 1, color_item = "#B3B3B3", size_item = 1, color_edge = "grey", size_edge = 0.5, categorySizeBy = ~itemNum, node_label = "all", foldChange = NULL, fc_threshold = NULL, hilight = "none", hilight_alpha = 0.3, ... ) \method{cnetplot}{compareClusterResult}( x, layout = igraph::layout_with_kk, showCategory = 5, color_category = "#E5C494", size_category = 1, color_item = "#B3B3B3", size_item = 1, color_edge = "grey", size_edge = 0.5, categorySizeBy = ~itemNum, node_label = "all", foldChange = NULL, fc_threshold = NULL, hilight = "none", hilight_alpha = 0.3, pie = "equal", split = NULL, includeAll = TRUE, ... ) } \arguments{ \item{x}{input object} \item{layout}{network layout} \item{showCategory}{number of categories to display or a vector of terms.} \item{color_category}{color of category nodes} \item{size_category}{relative size of the category nodes} \item{color_item}{color of item nodes} \item{size_item}{relative size of the item nodes (e.g., genes)} \item{color_edge}{color of edge} \item{size_edge}{relative size of edge} \item{categorySizeBy}{An expression (e.g., \code{itemNum}, \code{p.adjust}) or a formula (e.g., \code{~ -log10(p.adjust)}) to set the category node size. For \code{compareClusterResult}, this controls the category pie size.} \item{node_label}{one of 'all', 'none', 'category', 'item', 'exclusive' or 'share'. 'exclusive' labels genes that uniquely belong to categories; 'share' labels genes that are shared between categories.} \item{foldChange}{numeric values to color the item (e.g., fold change of gene expression values)} \item{fc_threshold}{threshold for filtering genes by absolute fold change (e.g., fc_threshold = 1 keeps only genes with |foldChange| > 1).} \item{hilight}{selected categories to be highlighted} \item{hilight_alpha}{transparency value for non-highlighted items} \item{...}{additional parameters} \item{pie}{one of 'equal' or 'Count' to set the slice ratio of the pies} \item{split}{apply \code{showCategory} to each category specified by \code{split} for \code{compareClusterResult}, e.g. \code{ONTOLOGY}, \code{category} or \code{intersect}.} \item{includeAll}{logical value passed to \code{fortify()} when selecting terms from a \code{compareClusterResult}.} } \description{ Category-gene-network plot } \seealso{ \link[ggtangle:cnetplot]{cnetplot} } ================================================ FILE: man/color_palette.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/color_utils.R \name{color_palette} \alias{color_palette} \title{Create color palette for continuous data} \usage{ color_palette(colors) } \arguments{ \item{colors}{colors of length >=2} } \value{ color vector } \description{ Create color palette for continuous data } \examples{ color_palette(c("red", "yellow", "green")) } \author{ guangchuang yu } ================================================ FILE: man/dotplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/dotplot.R \name{dotplot} \alias{dotplot} \alias{dotplot,enrichResult-method} \alias{dotplot,gseaResult-method} \alias{dotplot,compareClusterResult-method} \alias{dotplot,compareClusterResult,ANY-method} \alias{dotplot,enrichResultList-method} \alias{dotplot,enrichResultList,ANY-method} \alias{dotplot,gseaResultList-method} \alias{dotplot,gseaResultList,ANY-method} \alias{dotplot.enrichResult} \alias{dotplot.compareClusterResult} \title{dotplot} \usage{ dotplot(object, ...) \S4method{dotplot}{enrichResult}( object, x = "GeneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, ... ) \S4method{dotplot}{gseaResult}( object, x = "GeneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, ... ) \S4method{dotplot}{compareClusterResult}( object, x = "Cluster", color = "p.adjust", showCategory = 5, split = NULL, font.size = 12, title = "", by = "geneRatio", size = NULL, includeAll = TRUE, label_format = 30, ... ) \S4method{dotplot}{enrichResultList}( object, x = "GeneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, ... ) \S4method{dotplot}{gseaResultList}( object, x = "GeneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, ... ) dotplot.enrichResult( object, x = "geneRatio", color = "p.adjust", showCategory = 10, size = NULL, split = NULL, font.size = 12, title = "", orderBy = "x", label_format = 30, decreasing = TRUE ) dotplot.compareClusterResult( object, x = "Cluster", colorBy = "p.adjust", showCategory = 5, by = "geneRatio", size = "geneRatio", split = NULL, includeAll = TRUE, font.size = 12, title = "", label_format = 30, group = FALSE, shape = FALSE, facet = NULL, strip_width = 15 ) } \arguments{ \item{object}{compareClusterResult object} \item{...}{additional parameters.} \item{x}{variable for x-axis, one of 'GeneRatio' and 'Count'} \item{color}{variable used to color enriched terms, e.g. 'pvalue', 'p.adjust' or 'qvalue'} \item{showCategory}{number of categories to display or a vector of terms.} \item{size}{variable used to scale the sizes of categories, one of "geneRatio", "Percentage" and "count"} \item{split}{apply \code{showCategory} to each category specified by the 'split', e.g., "ONTOLOGY", "category" and "intersect". Default is NULL and do nothing} \item{font.size}{font size} \item{title}{figure title} \item{orderBy}{The order of the Y-axis} \item{label_format}{a numeric value sets wrap length, alternatively a custom function to format axis labels. by default wraps names longer than 30 characters} \item{by}{one of "geneRatio", "Percentage" and "count"} \item{includeAll}{logical value} \item{decreasing}{logical. Should the orderBy order be increasing or decreasing?} \item{colorBy}{variable used to color enriched terms, e.g. 'pvalue', 'p.adjust' or 'qvalue'} \item{group}{a logical value, whether to connect the nodes of the same group with wires.} \item{shape}{a logical value, whether to use nodes of different shapes to distinguish the group it belongs to} \item{facet}{apply \code{facet_grid} to the plot by specified variable, e.g., "ONTOLOGY", "category" and "intersect".} \item{strip_width}{width of strip text (facet label).} } \value{ plot. } \description{ Dot plot for enrichment result } \examples{ \dontrun{ library(DOSE) data(geneList) de <- names(geneList)[1:100] x <- enrichDO(de) dotplot(x) # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. dotplot(x, showCategory = 10) categories <- c("pre-malignant neoplasm", "intestinal disease", "breast ductal carcinoma", "non-small cell lung carcinoma") dotplot(x, showCategory = categories) # It can also graph compareClusterResult data(gcSample) library(clusterProfiler) library(DOSE) library(org.Hs.eg.db) data(gcSample) xx <- compareCluster(gcSample, fun="enrichGO", OrgDb="org.Hs.eg.db") xx2 <- pairwise_termsim(xx) library(ggstar) dotplot(xx2) dotplot(xx2, shape = TRUE) dotplot(xx2, group = TRUE) dotplot(xx2, x = "GeneRatio", group = TRUE, size = "count") } } \author{ Guangchuang Yu } ================================================ FILE: man/dotplot2.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/dotplot.R \name{dotplot2} \alias{dotplot2} \title{dotplot2} \usage{ dotplot2(object, x = "FoldEnrichment", vars = NULL, label = "auto", ...) } \arguments{ \item{object}{a compareClusterResult object} \item{x}{selected variable to visualize in x-axis} \item{vars}{selected Clusters to be compared, only length of two is supported} \item{label}{to label the Clusters in the plot, should be a named vector} \item{...}{additional parameters passed to dotplot} } \value{ a ggplot object } \description{ compare two clusters in the compareClusterResult object } \author{ Guangchuang Yu } ================================================ FILE: man/emapplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/emapplot.R \name{emapplot} \alias{emapplot} \alias{emapplot,enrichResult-method} \alias{emapplot,gseaResult-method} \alias{emapplot,compareClusterResult-method} \alias{emapplot_internal} \title{emapplot} \usage{ emapplot(x, ...) \S4method{emapplot}{enrichResult}(x, showCategory = 30, ...) \S4method{emapplot}{gseaResult}(x, showCategory = 30, ...) \S4method{emapplot}{compareClusterResult}(x, showCategory = 30, ...) emapplot_internal( x, layout = igraph::layout_with_kk, showCategory = 30, color = "p.adjust", size_category = 1, min_edge = 0.2, color_edge = "grey", size_edge = 0.5, node_label = "category", node_label_size = 5, pie = "equal", label_format = 30, clusterFunction = stats::kmeans, nWords = 4, nCluster = NULL ) } \arguments{ \item{x}{Enrichment result.} \item{...}{Additional parameters} \item{showCategory}{number of categories to display or a vector of terms.} \item{layout}{igraph layout} \item{color}{Variable used to color enriched terms, e.g. 'pvalue', 'p.adjust' or 'qvalue'.} \item{size_category}{relative size of the categories} \item{min_edge}{The minimum similarity threshold for whether two nodes are connected, should be between 0 and 1, default value is 0.2.} \item{color_edge}{color of the network edge} \item{size_edge}{relative size of edge width} \item{node_label}{Select which labels to display, one of 'category', 'group', 'all' and 'none'.} \item{node_label_size}{size of node label, default is 5.} \item{pie}{one of 'equal' or 'Count' to set the slice ratio of the pies} \item{label_format}{a numeric value sets wrap length, alternatively a custom function to format axis labels.} \item{clusterFunction}{clustering method function, such as \code{stats::kmeans} (default), \code{cluster::clara}, \code{cluster::fanny}, or \code{cluster::pam}.} \item{nWords}{Numeric, the number of words in the cluster tags, the default value is 4.} \item{nCluster}{Numeric, the number of clusters, the default value is square root of the number of nodes.} } \value{ ggplot object } \description{ Enrichment Map for enrichment result of over-representation test or gene set enrichment analysis } \details{ This function visualizes gene sets as a network (i.e. enrichment map). Mutually overlapping gene sets tend to cluster together, making it easier for interpretation. When the similarity between terms meets a certain threshold (default is 0.2, adjusted by parameter \code{min_edge}), there will be edges between terms. The stronger the similarity, the shorter and thicker the edges. The similarity between terms is obtained by the function \code{pairwise_termsim}. Details of the similarity calculation can be found in its documentation: \code{\link[=pairwise_termsim]{pairwise_termsim()}}. } \examples{ \dontrun{ library(DOSE) data(geneList) de <- names(geneList)[1:100] x <- enrichDO(de) x2 <- pairwise_termsim(x) emapplot(x2) # use `layout` to change the layout of map emapplot(x2, layout = "star") # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. emapplot(x2, showCategory = 10) categories <- c("pre-malignant neoplasm", "intestinal disease", "breast ductal carcinoma") emapplot(x2, showCategory = categories) # It can also graph compareClusterResult library(clusterProfiler) library(DOSE) library(org.Hs.eg.db) data(gcSample) xx <- compareCluster(gcSample, fun="enrichGO", OrgDb="org.Hs.eg.db") xx2 <- pairwise_termsim(xx) emapplot(xx2) } } \author{ Guangchuang Yu } ================================================ FILE: man/enrichplot-common-params.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \name{enrichplot-common-params} \alias{enrichplot-common-params} \title{Shared parameters for enrichment plots} \arguments{ \item{color}{variable used to color enriched terms, e.g. \code{'pvalue'}, \code{'p.adjust'}, or \code{'qvalue'}.} \item{showCategory}{number of categories to display, or a vector of terms.} \item{size}{variable used to scale category size, one of \code{"geneRatio"}, \code{"Percentage"}, or \code{"count"}.} \item{split}{apply \code{showCategory} to each category specified by \code{split}, e.g., \code{"ONTOLOGY"}, \code{"category"}, or \code{"intersect"}. Default is \code{NULL}.} \item{font.size}{font size.} \item{title}{figure title.} \item{label_format}{a numeric wrap width, or a custom function to format axis labels.} \item{includeAll}{logical value.} } \description{ Shared parameters for enrichment plots } \keyword{internal} ================================================ FILE: man/enrichplot-package.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/enrichplot-package.R \docType{package} \name{enrichplot-package} \alias{enrichplot} \alias{enrichplot-package} \title{enrichplot: Visualization of Functional Enrichment Result} \description{ The 'enrichplot' package provides visualization methods for interpreting functional enrichment results from ORA or GSEA analyses. It is designed to work with the 'clusterProfiler' ecosystem and builds on 'ggplot2' for flexible and extensible graphics. } \seealso{ Useful links: \itemize{ \item \url{https://yulab-smu.top/contribution-knowledge-mining/} \item Report bugs at \url{https://github.com/GuangchuangYu/enrichplot/issues} } } \author{ \strong{Maintainer}: Guangchuang Yu \email{guangchuangyu@gmail.com} (\href{https://orcid.org/0000-0002-6485-8781}{ORCID}) Other contributors: \itemize{ \item Chun-Hui Gao \email{gaospecial@gmail.com} (\href{https://orcid.org/0000-0002-1445-7939}{ORCID}) [contributor] } } \keyword{internal} ================================================ FILE: man/enrichplot-term-params.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R \name{enrichplot-term-params} \alias{enrichplot-term-params} \title{Shared term-plot parameters} \arguments{ \item{showCategory}{number of categories to display, or a vector of terms.} \item{color}{variable used to color enriched terms, e.g. \code{'pvalue'}, \code{'p.adjust'}, or \code{'qvalue'}.} \item{label_format}{a numeric wrap width, or a custom function to format axis labels.} } \description{ Shared term-plot parameters } \keyword{internal} ================================================ FILE: man/enrichplot_point_shape.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/color_utils.R \docType{data} \name{enrichplot_point_shape} \alias{enrichplot_point_shape} \title{Predefined color palettes} \format{ An object of class \code{numeric} of length 1. } \usage{ enrichplot_point_shape } \description{ Predefined color palettes } \keyword{datasets} ================================================ FILE: man/fortify.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/method-fortify.R \name{fortify.compareClusterResult} \alias{fortify.compareClusterResult} \alias{fortify.enrichResult} \title{fortify} \usage{ \method{fortify}{compareClusterResult}( model, data, showCategory = 5, by = "geneRatio", split = NULL, includeAll = TRUE, ... ) \method{fortify}{enrichResult}( model, data, showCategory = 5, by = "Count", order = FALSE, drop = FALSE, split = NULL, ... ) } \arguments{ \item{model}{'enrichResult' or 'compareClusterResult' object} \item{data}{not use here} \item{showCategory}{Category numbers to show} \item{by}{one of Count and GeneRatio} \item{split}{separate result by 'split' variable} \item{includeAll}{logical} \item{...}{additional parameter} \item{order}{logical} \item{drop}{logical} } \value{ data.frame data.frame } \description{ convert compareClusterResult to a data.frame that ready for plot convert enrichResult object for ggplot2 } \author{ Guangchuang Yu } ================================================ FILE: man/geom_gsea_gene.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/gseaplot.R \name{geom_gsea_gene} \alias{geom_gsea_gene} \title{geom_gsea_gene} \usage{ geom_gsea_gene( genes, mapping = NULL, geom = ggplot2::geom_text, ..., geneSet = NULL ) } \arguments{ \item{genes}{selected genes to be labeled} \item{mapping}{aesthetic mapping, default is NULL} \item{geom}{geometric layer to plot the gene labels, default is geom_text} \item{...}{additional parameters passed to the 'geom'} \item{geneSet}{choose which gene set(s) to be label if the plot contains multiple gene sets} } \value{ ggplot object } \description{ label genes in running score plot } \author{ Guangchuang Yu } ================================================ FILE: man/get_enrichplot_color.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/color_utils.R \name{get_enrichplot_color} \alias{get_enrichplot_color} \title{Color utility functions for enrichplot package} \usage{ get_enrichplot_color(n = 2) } \arguments{ \item{n}{number of colors (2 or 3)} } \value{ color vector } \description{ This file contains all color-related helper functions Get default enrichplot colors } ================================================ FILE: man/ggtable.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/ggtable.R \name{ggtable} \alias{ggtable} \title{ggtable} \usage{ ggtable(d, p = NULL) } \arguments{ \item{d}{data frame} \item{p}{ggplot object to extract color to color rownames(d), optional} } \value{ ggplot object } \description{ plot table } \author{ guangchuang yu } ================================================ FILE: man/goplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/goplot.R \name{goplot} \alias{goplot} \alias{goplot,enrichResult-method} \alias{goplot,gseaResult-method} \title{goplot} \usage{ goplot( x, showCategory = 10, color = "p.adjust", layout = "sugiyama", geom = "text", ... ) \S4method{goplot}{enrichResult}( x, showCategory = 10, color = "p.adjust", layout = igraph::layout_with_sugiyama, geom = "text", ... ) \S4method{goplot}{gseaResult}( x, showCategory = 10, color = "p.adjust", layout = igraph::layout_with_sugiyama, geom = "text", ... ) } \arguments{ \item{x}{enrichment result.} \item{showCategory}{number of categories to display, or a vector of terms.} \item{color}{variable used to color enriched terms, e.g. \code{'pvalue'}, \code{'p.adjust'}, or \code{'qvalue'}.} \item{layout}{layout of the map} \item{geom}{label geom, one of 'label' or 'text'} \item{...}{additional parameters.} } \value{ ggplot object } \description{ Plot induced GO DAG of significant terms } \examples{ \dontrun{ library(clusterProfiler) data(geneList, package = "DOSE") de <- names(geneList)[1:100] yy <- enrichGO(de, 'org.Hs.eg.db', ont="BP", pvalueCutoff=0.01) goplot(yy) goplot(yy, showCategory = 5) } } \author{ Guangchuang Yu } ================================================ FILE: man/gsInfo.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/gseaplot.R \name{gsInfo} \alias{gsInfo} \title{gsInfo} \usage{ gsInfo(object, geneSetID) } \arguments{ \item{object}{gseaResult object} \item{geneSetID}{gene set ID} } \value{ data.frame } \description{ extract gsea result of selected geneSet } \author{ Guangchuang Yu } ================================================ FILE: man/gseadist.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/densityplot.R \name{gseadist} \alias{gseadist} \title{gseadist} \usage{ gseadist(x, IDs, type = "density") } \arguments{ \item{x}{GSEA result} \item{IDs}{gene set IDs} \item{type}{one of 'density' or 'boxplot'} } \value{ distribution plot } \description{ plot logFC distribution of selected gene sets } \author{ Guangchuang Yu } ================================================ FILE: man/gseaplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/gseaplot.R \name{gseaplot} \alias{gseaplot} \alias{gseaplot,gseaResult-method} \alias{gseaplot.gseaResult} \title{gseaplot} \usage{ gseaplot(x, geneSetID, by = "all", title = "", ...) \S4method{gseaplot}{gseaResult}( x, geneSetID, by = "all", title = "", color = "black", color.line = "green", color.vline = "#FA5860", ... ) gseaplot.gseaResult( x, geneSetID, by = "all", title = "", color = "black", color.line = "green", color.vline = "#FA5860", ... ) } \arguments{ \item{x}{gseaResult object} \item{geneSetID}{geneSet ID} \item{by}{one of "runningScore" or "position"} \item{title}{plot title} \item{...}{additional parameters} \item{color}{color of line segments} \item{color.line}{color of running enrichment score line} \item{color.vline}{color of vertical line indicating the maximum/minimal running enrichment score} } \value{ ggplot2 object ggplot2 object } \description{ Visualize GSEA analysis results } \details{ Plotting function for gseaResult } \examples{ \donttest{ library(DOSE) data(geneList) x <- gseDO(geneList) gseaplot(x, geneSetID=1) } } \author{ Guangchuang Yu } ================================================ FILE: man/gseaplot2.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/gseaplot.R \name{gseaplot2} \alias{gseaplot2} \title{gseaplot2} \usage{ gseaplot2( x, geneSetID, title = "", color = "green", base_size = 11, rel_heights = c(1.5, 0.5, 1), subplots = 1:3, pvalue_table = FALSE, pvalue_table_columns = c("pvalue", "p.adjust"), pvalue_table_rownames = "Description", ES_geom = "line" ) } \arguments{ \item{x}{gseaResult object} \item{geneSetID}{gene set ID} \item{title}{plot title} \item{color}{color of running enrichment score line} \item{base_size}{base font size} \item{rel_heights}{relative heights of subplots} \item{subplots}{which subplots to be displayed} \item{pvalue_table}{whether add pvalue table} \item{pvalue_table_columns}{selected columns to be plotted in the \code{pvalue_table}} \item{pvalue_table_rownames}{selected column as the rownames of the \code{pvalue_table}. If set to NULL, no rownames will be displayed.} \item{ES_geom}{geom for plotting running enrichment score, one of 'line' or 'dot'} } \value{ plot } \description{ GSEA plot that mimic the plot generated by broad institute's GSEA software } \author{ Guangchuang Yu } ================================================ FILE: man/gsearank.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/gseaplot.R \name{gsearank} \alias{gsearank} \title{gsearank} \usage{ gsearank(x, geneSetID, title = "", output = "plot") } \arguments{ \item{x}{gseaResult object} \item{geneSetID}{gene set ID} \item{title}{plot title} \item{output}{one of 'plot' or 'table' (for exporting data)} } \value{ ggplot object } \description{ plot ranked list of genes with running enrichment score as bar height } \author{ Guangchuang Yu } ================================================ FILE: man/heatplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/heatplot.R \name{heatplot} \alias{heatplot} \alias{heatplot,enrichResult-method} \alias{heatplot,gseaResult-method} \alias{heatplot.enrichResult} \title{heatplot} \usage{ heatplot(x, showCategory = 30, ...) \S4method{heatplot}{enrichResult}(x, showCategory = 30, ...) \S4method{heatplot}{gseaResult}(x, showCategory = 30, ...) heatplot.enrichResult( x, showCategory = 30, showTop = NULL, symbol = "rect", foldChange = NULL, pvalue = NULL, label_format = 30 ) } \arguments{ \item{x}{enrichment result.} \item{showCategory}{number of enriched terms to display} \item{...}{Additional parameters} \item{showTop}{number of top genes ranked by \code{abs(foldChange) * frequency} to be shown in the heatmap, default NULL means all genes are shown} \item{symbol}{symbol of the nodes, one of "rect" (the default) or "dot"} \item{foldChange}{fold change.} \item{pvalue}{pvalue of genes} \item{label_format}{a numeric value sets wrap length, alternatively a custom function to format axis labels. by default wraps names longer than 30 characters} } \value{ ggplot object } \description{ Heatmap-like plot for functional classification } \examples{ library(DOSE) data(geneList) de <- names(geneList)[1:100] x <- enrichDO(de) heatplot(x) } \author{ Guangchuang Yu } ================================================ FILE: man/hplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/gseaplot.R \name{hplot} \alias{hplot} \title{hplot} \usage{ hplot(x, geneSetID) } \arguments{ \item{x}{gseaResult object} \item{geneSetID}{gene set ID} } \value{ horizontal plot } \description{ Horizontal plot for GSEA result } \author{ Guangchuang Yu } ================================================ FILE: man/manhattanplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/manhattanplot.R \name{manhattanplot} \alias{manhattanplot} \alias{manhattanplot,enrichResult-method} \alias{manhattanplot,gseaResult-method} \alias{manhattanplot,compareClusterResult-method} \alias{manhattanplot,compareClusterResult,ANY-method} \alias{manhattanplot,enrichResultList-method} \alias{manhattanplot,enrichResultList,ANY-method} \alias{manhattanplot,gseaResultList-method} \alias{manhattanplot,gseaResultList,ANY-method} \alias{manhattanplot,list-method} \alias{manhattanplot,list,ANY-method} \title{manhattanplot} \usage{ manhattanplot(x, ...) \S4method{manhattanplot}{enrichResult}( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) \S4method{manhattanplot}{gseaResult}( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) \S4method{manhattanplot}{compareClusterResult}( x, color = "p.adjust", showCategory = 5, split = NULL, font.size = 12, title = "", size = "Count", includeAll = TRUE, label_format = 30, ... ) \S4method{manhattanplot}{enrichResultList}( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) \S4method{manhattanplot}{gseaResultList}( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) \S4method{manhattanplot}{list}( x, color = "p.adjust", showCategory = 5, size = "Count", split = NULL, font.size = 12, title = "", label_format = 30, ... ) } \arguments{ \item{x}{enrichment result.} \item{...}{additional parameters.} \item{color}{variable used to color enriched terms, e.g. \code{'pvalue'}, \code{'p.adjust'}, or \code{'qvalue'}.} \item{showCategory}{number of categories to display, or a vector of terms.} \item{size}{variable used to scale category size, one of \code{"geneRatio"}, \code{"Percentage"}, or \code{"count"}.} \item{split}{apply \code{showCategory} to each category specified by \code{split}, e.g., \code{"ONTOLOGY"}, \code{"category"}, or \code{"intersect"}. Default is \code{NULL}.} \item{font.size}{font size.} \item{title}{figure title.} \item{label_format}{a numeric wrap width, or a custom function to format axis labels.} \item{includeAll}{logical value.} } \value{ ggplot object } \description{ Manhattan plot for enrichment result } \author{ Guangchuang Yu } ================================================ FILE: man/pairwise_termsim.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/pairwise_termsim.R \name{pairwise_termsim} \alias{pairwise_termsim} \alias{pairwise_termsim,enrichResult-method} \alias{pairwise_termsim,gseaResult-method} \alias{pairwise_termsim,compareClusterResult-method} \alias{pairwise_termsim.enrichResult} \alias{pairwise_termsim.compareClusterResult} \title{pairwise_termsim} \usage{ pairwise_termsim(x, method = "JC", semData = NULL, showCategory = NULL) \S4method{pairwise_termsim}{enrichResult}(x, method = "JC", semData = NULL, showCategory = NULL) \S4method{pairwise_termsim}{gseaResult}(x, method = "JC", semData = NULL, showCategory = NULL) \S4method{pairwise_termsim}{compareClusterResult}(x, method = "JC", semData = NULL, showCategory = NULL) pairwise_termsim.enrichResult( x, method = "JC", semData = NULL, showCategory = NULL ) pairwise_termsim.compareClusterResult( x, method = "JC", semData = NULL, showCategory = NULL ) } \arguments{ \item{x}{enrichment result.} \item{method}{method of calculating the similarity between nodes, one of "Resnik", "Lin", "Rel", "Jiang", "Wang", and "JC" (Jaccard similarity coefficient) methods.} \item{semData}{\code{GOSemSimDATA} object, can be obtained through \code{GOSemSim::godata}.} \item{showCategory}{number of enriched terms to be calculated. The default value is the number of enriched terms, or 200 if the number of enriched terms exceeds 200.} } \description{ Get the similarity matrix } \details{ This function adds a similarity matrix to the termsim slot of the enrichment result. Users can use the \code{method} parameter to select the method of calculating the similarity. The Jaccard correlation coefficient (JC) is used by default, and it applies to all situations. When users want to calculate the correlation between GO terms or DO terms, they can also choose "Resnik", "Lin", "Rel" or "Jiang" (they are semantic similarity calculation methods from the 'GOSemSim' package), and at this time, the user needs to provide the \code{semData} parameter, which can be obtained through \code{\link[GOSemSim:godata]{GOSemSim::godata()}}. } \examples{ \dontrun{ library(clusterProfiler) library(org.Hs.eg.db) library(enrichplot) library(GOSemSim) library(DOSE) data(geneList) gene <- names(geneList)[abs(geneList) > 2] ego <- enrichGO(gene = gene, universe = names(geneList), OrgDb = org.Hs.eg.db, ont = "BP", pAdjustMethod = "BH", pvalueCutoff = 0.01, qvalueCutoff = 0.05, readable = TRUE) d <- godata('org.Hs.eg.db', ont="BP") ego2 <- pairwise_termsim(ego, method="Wang", semData = d) emapplot(ego2) emapplot_cluster(ego2) } } ================================================ FILE: man/plotting.clusterProfile.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot_utils.R \name{plotting.clusterProfile} \alias{plotting.clusterProfile} \title{Internal plot function for plotting compareClusterResult} \usage{ plotting.clusterProfile( clProf.reshape.df, x = ~Cluster, type = "dot", colorBy = "p.adjust", by = "geneRatio", title = "", font.size = 12 ) } \arguments{ \item{clProf.reshape.df}{data frame of compareCluster result} \item{x}{x variable} \item{type}{one of dot and bar} \item{colorBy}{one of pvalue or p.adjust} \item{by}{one of percentage and count} \item{title}{graph title} \item{font.size}{graph font size} } \value{ ggplot object } \description{ Internal plot function for plotting compareClusterResult } \author{ Guangchuang Yu \url{https://yulab-smu.top} } ================================================ FILE: man/pmcplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/pmcplot.R \name{pmcplot} \alias{pmcplot} \title{pmcplot} \usage{ pmcplot(query, period, proportion = TRUE) } \arguments{ \item{query}{query terms} \item{period}{period of query in the unit of year} \item{proportion}{If TRUE, use query_hits/all_hits, otherwise use query_hits.} } \value{ ggplot object } \description{ PubMed Central Trend plot } \author{ Guangchuang Yu } ================================================ FILE: man/reexports.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/reexport.R \docType{import} \name{reexports} \alias{reexports} \alias{ggtitle} \alias{facet_grid} \alias{plot_list} \alias{cnetplot} \alias{theme_dose} \alias{geom_cnet_label} \alias{gseaScores} \alias{geneID} \alias{geneInCategory} \title{Objects exported from other packages} \keyword{internal} \description{ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ \item{aplot}{\code{\link[aplot]{plot_list}}} \item{DOSE}{\code{\link[DOSE]{theme_dose}}} \item{enrichit}{\code{\link[enrichit]{geneID}}, \code{\link[enrichit]{geneInCategory}}, \code{\link[enrichit]{gseaScores}}} \item{ggplot2}{\code{\link[ggplot2]{facet_grid}}, \code{\link[ggplot2:labs]{ggtitle}}} \item{ggtangle}{\code{\link[ggtangle]{cnetplot}}, \code{\link[ggtangle]{geom_cnet_label}}} }} ================================================ FILE: man/ridgeplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/ridgeplot.R \name{ridgeplot} \alias{ridgeplot} \alias{ridgeplot,gseaResult-method} \alias{ridgeplot.gseaResult} \title{ridgeplot} \usage{ ridgeplot( x, showCategory = 30, fill = "p.adjust", core_enrichment = TRUE, label_format = 30, ... ) \S4method{ridgeplot}{gseaResult}( x, showCategory = 30, fill = "p.adjust", core_enrichment = TRUE, label_format = 30, ... ) ridgeplot.gseaResult( x, showCategory = 30, fill = "p.adjust", core_enrichment = TRUE, label_format = 30, orderBy = "NES", decreasing = FALSE, stat = "density_ridges" ) } \arguments{ \item{x}{gseaResult object} \item{showCategory}{number of categories to display or a vector of terms.} \item{fill}{one of "pvalue", "p.adjust", "qvalue"} \item{core_enrichment}{whether to use only core_enriched genes} \item{label_format}{a numeric value setting the wrap length, alternatively a custom function to format axis labels.} \item{...}{additional parameters.} \item{orderBy}{The order of the Y-axis} \item{decreasing}{logical. Should the orderBy order be increasing or decreasing?} \item{stat}{statistic passed to \code{ggridges::geom_density_ridges()}.} } \value{ ggplot object } \description{ Ridgeline plot for GSEA result } \examples{ \donttest{ library(DOSE) data(geneList) x <- gseDO(geneList) ridgeplot(x) } } \author{ Guangchuang Yu } ================================================ FILE: man/set_enrichplot_color.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/color_utils.R \name{set_enrichplot_color} \alias{set_enrichplot_color} \title{Helper function to set color scale for enrichplot} \usage{ set_enrichplot_color( colors = get_enrichplot_color(2), type = "color", name = NULL, .fun = NULL, reverse = TRUE, transform = "identity", ... ) } \arguments{ \item{colors}{user provided color vector} \item{type}{one of 'color', 'colour' or 'fill'} \item{name}{name of the color legend} \item{.fun}{force to use user provided color scale function} \item{reverse}{whether reverse the color scheme} \item{transform}{transform the color scale} \item{...}{additional parameters} } \value{ a color scale } \description{ Helper function to set color scale for enrichplot } \author{ Guangchuang Yu } ================================================ FILE: man/ssplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/ssplot.R \name{ssplot} \alias{ssplot} \alias{ssplot,enrichResult-method} \alias{ssplot,gseaResult-method} \alias{ssplot,compareClusterResult-method} \alias{ssplot.enrichResult} \alias{ssplot.compareClusterResult} \title{ssplot} \usage{ ssplot(x, ...) \S4method{ssplot}{enrichResult}(x, showCategory = 30, ...) \S4method{ssplot}{gseaResult}(x, showCategory = 30, ...) \S4method{ssplot}{compareClusterResult}(x, showCategory = 30, ...) ssplot.enrichResult( x, showCategory = 30, drfun = NULL, dr.params = list(), node_label = "group", ... ) ssplot.compareClusterResult( x, showCategory = 30, pie = "equal", drfun = NULL, dr.params = list(), node_label = "group", ... ) } \arguments{ \item{x}{Enrichment result.} \item{...}{additional parameters Additional plotting parameters are inherited from \code{\link[=emapplot]{emapplot()}}.} \item{showCategory}{number of categories to display or a vector of terms.} \item{drfun}{The function used for dimension reduction, e.g. \code{stats::cmdscale} (the default), \code{vegan::metaMDS}, or \code{ape::pcoa}.} \item{dr.params}{list, the parameters of \code{tidydr::dr}.} \item{node_label}{Select which labels to display, one of 'category', 'group', 'all' and 'none'.} \item{pie}{one of 'equal' or 'Count' to set the slice ratio of the pies} } \value{ ggplot object } \description{ Similarity Space Plot for enrichment analysis } \details{ Creates 2D visualization of enrichment results using dimension reduction techniques to show relationships between terms based on similarity. } \examples{ \dontrun{ library(clusterProfiler) library(org.Hs.eg.db) library(enrichplot) library(GOSemSim) library(DOSE) data(geneList) gene <- names(geneList)[abs(geneList) > 2] ego <- enrichGO(gene = gene, universe = names(geneList), OrgDb = org.Hs.eg.db, ont = "BP", pAdjustMethod = "BH", pvalueCutoff = 0.01, qvalueCutoff = 0.05, readable = TRUE) d <- godata('org.Hs.eg.db', ont="BP") ego2 <- pairwise_termsim(ego, method = "Wang", semData = d) ssplot(ego2) } } \author{ Guangchuang Yu } ================================================ FILE: man/treeplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/treeplot.R \name{treeplot} \alias{treeplot} \alias{treeplot,enrichResult-method} \alias{treeplot,gseaResult-method} \alias{treeplot,compareClusterResult-method} \alias{treeplot_internal} \title{treeplot} \usage{ treeplot(x, ...) \S4method{treeplot}{enrichResult}(x, ...) \S4method{treeplot}{gseaResult}(x, ...) \S4method{treeplot}{compareClusterResult}(x, ...) treeplot_internal( x, showCategory = 30, color = "p.adjust", size_var = c("Count", "setSize"), nCluster = 5, cluster_method = "ward.D", label_format = 30, fontsize_tiplab = 4, fontsize_cladelab = 4, group_color = NULL, extend = 0.3, hilight = TRUE, align = "both", hexpand = 0.1, tiplab_offset = 0.2, cladelab_offset = 1 ) } \arguments{ \item{x}{enrichment result.} \item{...}{additional parameters} \item{showCategory}{number of enriched terms to display} \item{color}{variable to color nodes, e.g. 'p.adjust', 'pvalue', or 'qvalue'} \item{size_var}{variable for node size, e.g. 'Count' (for enrichResult) or 'setSize' (for gseaResult)} \item{nCluster}{number of clusters for tree cutting} \item{cluster_method}{hierarchical clustering method} \item{label_format}{wrap length for labels or custom formatting function} \item{fontsize_tiplab}{font size for tip labels} \item{fontsize_cladelab}{font size for clade labels} \item{group_color}{vector of colors for groups} \item{extend}{extend length for clade labels} \item{hilight}{whether to highlight clades} \item{align}{alignment for highlight rectangles} \item{hexpand}{expand x limits by amount of xrange * hexpand} \item{tiplab_offset}{offset for tip labels} \item{cladelab_offset}{offset for clade labels} } \value{ ggplot object ggplot2 object representing the tree plot } \description{ Functional grouping tree diagram for enrichment result of over-representation test or gene set enrichment analysis. Creates hierarchical tree visualization of enriched terms based on similarity } \details{ This function visualizes gene sets as a tree. Gene sets with high similarity tend to cluster together, making it easier for interpretation. } \examples{ \dontrun{ library(clusterProfiler) library(org.Hs.eg.db) library(enrichplot) library(GOSemSim) library(ggplot2) library(DOSE) data(geneList) gene <- names(geneList)[abs(geneList) > 2] ego <- enrichGO(gene = gene, universe = names(geneList), OrgDb = org.Hs.eg.db, ont = "BP", pAdjustMethod = "BH", pvalueCutoff = 0.01, qvalueCutoff = 0.05, readable = TRUE) d <- godata('org.Hs.eg.db', ont="BP") ego2 <- pairwise_termsim(ego, method = "Wang", semData = d) treeplot(ego2, showCategory = 30) # use `hilight = FALSE` to remove ggtree::geom_hilight() layer. treeplot(ego2, showCategory = 30, hilight = FALSE) # use `offset` parameter to adjust the distance of bar and tree. treeplot(ego2, showCategory = 30, hilight = FALSE, offset = rel(1.5)) # use `offset_tiplab` parameter to adjust the distance of nodes and branches. treeplot(ego2, showCategory = 30, hilight = FALSE, offset_tiplab = rel(1.5)) keep <- rownames(ego2@termsim)[c(1:10, 16:20)] keep treeplot(ego2, showCategory = keep) treeplot(ego2, showCategory = 20, group_color = c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442")) # It can also graph compareClusterResult data(gcSample) xx <- compareCluster(gcSample, fun="enrichKEGG", organism="hsa", pvalueCutoff=0.05) xx <- pairwise_termsim(xx) treeplot(xx) # use `geneClusterPanel` to change the gene cluster panel. treeplot(xx, geneClusterPanel = "dotplot") treeplot(xx, geneClusterPanel = "pie") } } ================================================ FILE: man/upsetplot-methods.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/upsetplot.R \docType{methods} \name{upsetplot} \alias{upsetplot} \alias{upsetplot,enrichResult-method} \alias{upsetplot,enrichResult,ANY-method} \alias{upsetplot,gseaResult-method} \alias{upsetplot,gseaResult} \title{upsetplot method} \usage{ upsetplot(x, ...) \S4method{upsetplot}{enrichResult}(x, n = 10, ...) \S4method{upsetplot}{gseaResult}(x, n = 10, ...) } \arguments{ \item{x}{object} \item{...}{additional parameters} \item{n}{number of categories to be plotted} } \value{ plot } \description{ upsetplot method generics Upsetplot } \examples{ library(DOSE) data(geneList) de <- names(geneList)[1:100] x <- enrichDO(de) upsetplot(x, 8) } \author{ Guangchuang Yu } ================================================ FILE: man/volplot.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/volplot.R \name{volplot} \alias{volplot} \alias{volplot,enrichResult-method} \alias{volplot.enrichResult} \title{volplot} \usage{ volplot( x, color = "zScore", xintercept = 1, yintercept = 2, showCategory = 5, label_format = 30, ... ) \S4method{volplot}{enrichResult}( x, color = "zScore", xintercept = 1, yintercept = 2, showCategory = 5, label_format = 30, ... ) volplot.enrichResult( x, color = "zScore", xintercept = 1, yintercept = 2, showCategory = 5, label_format = 30, font.size = 12, size = 5 ) } \arguments{ \item{x}{enrichment result.} \item{color}{selected variable to color the dots} \item{xintercept}{value to set x-intercept} \item{yintercept}{value to set y-intercept} \item{showCategory}{number of most significant enriched terms or selected terms to display determined by the variable selected to color the dots} \item{label_format}{a numeric value setting the wrap length, alternatively a custom function to format axis labels.} \item{...}{Additional parameters} \item{font.size}{font size for \code{theme_dose()}} \item{size}{font size to label selected categories specified by showCategory} } \value{ ggplot object } \description{ Volcano plot for enrichment result } \examples{ library(DOSE) data(geneList) de <- names(geneList)[1:100] x <- enrichDO(de) volplot(x) } \author{ Guangchuang Yu } ================================================ FILE: vignettes/enrichplot.qmd ================================================ --- title: "Visualization of Functional Enrichment Result" format: html: theme: none embed-resources: true fontsize: 1.1em linestretch: 1.7 author: "Guangchuang Yu\\ School of Basic Medical Sciences, Southern Medical University" date: "`r Sys.Date()`" vignette: > %\VignetteIndexEntry{enrichplot} %\VignetteEngine{quarto::html} %\VignetteEncoding{UTF-8} --- Please go to for the full vignette.