Showing preview only (279K chars total). Download the full file or copy to clipboard to get everything.
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`
- <https://github.com/YuLab-SMU/clusterProfiler/issues/774>
# 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)
- <https://github.com/YuLab-SMU/enrichplot/issues/292#issuecomment-2445788948>
# 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)
- <https://github.com/YuLab-SMU/enrichplot/pull/84/>
+ update `emapplot_cluster()` to label cluster in center by default and use `ggrepel` if setting `repel = TRUE` (2020-11-08, Mon)
- <https://github.com/YuLab-SMU/enrichplot/pull/81>
+ 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
+ <https://github.com/YuLab-SMU/enrichplot/pull/73>
# 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)
- <https://github.com/YuLab-SMU/enrichplot/pull/67>
+ change parameters to be more consistent
- <https://github.com/YuLab-SMU/enrichplot/pull/62>
# 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)
- <https://github.com/YuLab-SMU/enrichplot/pull/40>
# 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)
- <https://yulab-smu.github.io/clusterProfiler-book/chapter12.html#fig:cnetNodeLabel>
+ `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`
- <https://support.bioconductor.org/p/109438/#109451>
+ `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`
- <https://github.com/GuangchuangYu/DOSE/issues/20#issuecomment-391802809>
# 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>
- <https://twitter.com/S_Canchi/status/974440351162294272>
+ enable using formula to specify x axis in `dotplot`
# enrichplot 0.99.13
+ fixed `goplot` issue by imporint `ggraph` <2018-03-12, Mon>
- <https://github.com/GuangchuangYu/enrichplot/issues/5>
- >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 <https://yulab-smu.top>
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 point
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
Condensed preview — 79 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (282K chars).
[
{
"path": ".Rbuildignore",
"chars": 99,
"preview": "^.*\\.Rproj$\n^\\.Rproj\\.user$\nMakefile\n^CONDUCT\\.md$\nREADME.Rmd\nREADME.md\nTODO.md\nRplots.pdf\n^\\.dev$\n"
},
{
"path": ".dev/cnetplot_comparecluster_design.md",
"chars": 10357,
"preview": "# compareCluster cnetplot Design Draft\n\n## Goal\nUpdate `enrichplot::cnetplot.compareClusterResult()` so that `compareClu"
},
{
"path": ".dev/manhattan_plot_plan.md",
"chars": 2939,
"preview": "# Manhattan Plot Implementation Plan\n\n## Goal\nImplement a `manhattanplot()` function in the `enrichplot` package to visu"
},
{
"path": ".gitignore",
"chars": 81,
"preview": ".Rproj.user\n.Rhistory\n.RData\n*.DS_Store\n*html\n\n.vscode/\nRplots*\n*.log\nRplots.pdf\n"
},
{
"path": "CONDUCT.md",
"chars": 1387,
"preview": "# Contributor Code of Conduct\n\nAs contributors and maintainers of this project, we pledge to respect all people who \ncon"
},
{
"path": "DESCRIPTION",
"chars": 1701,
"preview": "Package: enrichplot\nTitle: Visualization of Functional Enrichment Result\nVersion: 1.33.0\nAuthors@R: c(\n person(given "
},
{
"path": "Makefile",
"chars": 1376,
"preview": "PKGNAME := $(shell sed -n \"s/Package: *\\([^ ]*\\)/\\1/p\" DESCRIPTION)\nPKGVERS := $(shell sed -n \"s/Version: *\\([^ ]*\\)/\\1/"
},
{
"path": "NAMESPACE",
"chars": 5394,
"preview": "# Generated by roxygen2: do not edit by hand\n\nS3method(as.data.frame,compareClusterResult)\nS3method(barplot,compareClust"
},
{
"path": "NEWS.md",
"chars": 18883,
"preview": "# enrichplot 1.32.0\n\n+ Bioconductor RELEASE_3_23 (2026-04-29, Wed)\n\n# enrichplot 1.31.5\n\n+ `cnetplot.compareClusterResul"
},
{
"path": "R/00-AllClasses.R",
"chars": 97,
"preview": "#' @importFrom methods setOldClass\nsetOldClass(\"enrichResultList\")\nsetOldClass(\"gseaResultList\")\n"
},
{
"path": "R/AllGenerics.R",
"chars": 14446,
"preview": "#' Dot plot for enrichment result\n#'\n#'\n#' @title dotplot\n#' @rdname dotplot\n#' @param object input object.\n#' @param .."
},
{
"path": "R/barplot.R",
"chars": 4381,
"preview": "#' Barplot of enrichResult\n#'\n#' Barplot of enrichResult\n#'\n#' @importFrom graphics barplot\n#' @importFrom ggplot2 %+%\n#"
},
{
"path": "R/cnetplot.R",
"chars": 11256,
"preview": "#' Category-Gene-Network Plot\n#'\n#' Category-gene-network plot\n#' @rdname cnetplot\n#' @param x input object\n#' @param la"
},
{
"path": "R/color_utils.R",
"chars": 4162,
"preview": "#' Color utility functions for enrichplot package\n#'\n#' This file contains all color-related helper functions\n\n#' Get de"
},
{
"path": "R/data_utils.R",
"chars": 6978,
"preview": "#' Data processing utility functions for enrichplot package\n#'\n#' This file contains data manipulation and processing he"
},
{
"path": "R/densityplot.R",
"chars": 1529,
"preview": "#' plot logFC distribution of selected gene sets\n#'\n#' \n#' @title gseadist \n#' @param x GSEA result\n#' @param IDs gene s"
},
{
"path": "R/dotplot.R",
"chars": 17006,
"preview": "#' @rdname dotplot\n#' @exportMethod dotplot\n#' @author Guangchuang Yu\nsetMethod(\n \"dotplot\",\n signature(object = \""
},
{
"path": "R/emapplot.R",
"chars": 6906,
"preview": "#' @rdname emapplot\n#' @exportMethod emapplot\nsetMethod(\n \"emapplot\",\n signature(x = \"enrichResult\"),\n function"
},
{
"path": "R/emapplot_utilities.R",
"chars": 10763,
"preview": "#' Get the similarity matrix\n#'\n#' @param y A data.frame of enrichment result\n#' @param geneSets A list, the names of ge"
},
{
"path": "R/enrichplot-package.R",
"chars": 34,
"preview": "#' @keywords internal\n\"_PACKAGE\"\n\n"
},
{
"path": "R/ggtable.R",
"chars": 1387,
"preview": "#' plot table\n#'\n#'\n#' @title ggtable\n#' @param d data frame\n#' @param p ggplot object to extract color to color rowname"
},
{
"path": "R/goplot.R",
"chars": 3852,
"preview": "#' @rdname goplot\n#' @exportMethod goplot\nsetMethod(\"goplot\", signature(x = \"enrichResult\"),\n function(x, showC"
},
{
"path": "R/gseaplot.R",
"chars": 16752,
"preview": "#' @rdname gseaplot\n#' @exportMethod gseaplot\nsetMethod(\n \"gseaplot\",\n signature(x = \"gseaResult\"),\n function(\n"
},
{
"path": "R/heatplot.R",
"chars": 4494,
"preview": "#' @rdname heatplot\n#' @exportMethod heatplot\nsetMethod(\n \"heatplot\",\n signature(x = \"enrichResult\"),\n function"
},
{
"path": "R/manhattanplot.R",
"chars": 11556,
"preview": "#' @rdname manhattanplot\n#' @exportMethod manhattanplot\n#' @author Guangchuang Yu\nsetMethod(\n \"manhattanplot\",\n si"
},
{
"path": "R/method-fortify.R",
"chars": 8164,
"preview": "#' convert compareClusterResult to a data.frame that ready for plot\n#'\n#'\n#' @rdname fortify\n#' @title fortify\n#' @param"
},
{
"path": "R/method-ggplot-add.R",
"chars": 701,
"preview": "#' @importFrom ggplot2 ggplot_add\n#' @method ggplot_add autofacet\n#' @export\nggplot_add.autofacet <- function(object, pl"
},
{
"path": "R/method-print.r",
"chars": 170,
"preview": "#' @method print enrichplotDot\n#' @export\nprint.enrichplotDot <- function(x, ...) {\n p <- ggfun::set_point_legend_sha"
},
{
"path": "R/pairwise_termsim.R",
"chars": 2705,
"preview": "#' @rdname pairwise_termsim\n#' @exportMethod pairwise_termsim\nsetMethod(\"pairwise_termsim\", signature(x = \"enrichResult\""
},
{
"path": "R/plot_utils.R",
"chars": 4274,
"preview": "#' Plotting utility functions for enrichplot package\n#'\n#' This file contains plotting and visualization helper function"
},
{
"path": "R/pmcplot.R",
"chars": 1098,
"preview": "#' PubMed Central Trend plot\n#'\n#'\n#' @title pmcplot\n#' @param query query terms\n#' @param period period of query in the"
},
{
"path": "R/reexport.R",
"chars": 651,
"preview": "#' @importFrom ggplot2 ggtitle\n#' @export\nggplot2::ggtitle\n\n#' @importFrom ggplot2 facet_grid\n#' @export\nggplot2::facet_"
},
{
"path": "R/ridgeplot.R",
"chars": 4505,
"preview": "#' @rdname ridgeplot\n#' @exportMethod ridgeplot\nsetMethod(\n \"ridgeplot\",\n signature(x = \"gseaResult\"),\n functio"
},
{
"path": "R/ssplot.R",
"chars": 8111,
"preview": "#' @rdname ssplot\n#' @exportMethod ssplot\nsetMethod(\n \"ssplot\",\n signature(x = \"enrichResult\"),\n function(x, sh"
},
{
"path": "R/treeplot.R",
"chars": 16814,
"preview": "#' Tree plot for enrichment results\n#'\n#' Creates hierarchical tree visualization of enriched terms based on similarity\n"
},
{
"path": "R/upsetplot.R",
"chars": 3779,
"preview": "#' Upsetplot\n#'\n#' Upsetplot\n#'\n#' @rdname upsetplot-methods\n#' @aliases upsetplot,enrichResult,ANY-method\n#' @param n n"
},
{
"path": "R/volplot.R",
"chars": 1894,
"preview": "#' @rdname volplot\n#' @exportMethod volplot\n#' @author Guangchuang Yu\nsetMethod(\"volplot\", signature(x = \"enrichResult\")"
},
{
"path": "R/wordcloud.R",
"chars": 3473,
"preview": "#' Use wordcloud algorithm to get group tags\n#'\n#' @param cluster a cluster name\n#' @param node_data the data section of"
},
{
"path": "R/zzz.R",
"chars": 186,
"preview": "#' @importFrom yulab.utils yulab_msg\n.onAttach <- function(libname, pkgname) {\n options(check.tbl_tree.verbose = FALS"
},
{
"path": "README.Rmd",
"chars": 2419,
"preview": "---\noutput:\n md_document:\n variant: gfm\nhtml_preview: false\n---\n\n<!-- README.md is generated from README.Rmd. Please"
},
{
"path": "README.md",
"chars": 2779,
"preview": "<!-- README.md is generated from README.Rmd. Please edit that file -->\n\n# Visualization of Functional Enrichment Result\n"
},
{
"path": "TODO.md",
"chars": 604,
"preview": "# TODO LIST\n\n+ [x] manhattan plot for enriched result\n - figure 1 of <https://f1000research.com/articles/9-709>\n+ [ ] C"
},
{
"path": "enrichplot.Rproj",
"chars": 385,
"preview": "Version: 1.0\n\nRestoreWorkspace: No\nSaveWorkspace: No\nAlwaysSaveHistory: Default\n\nEnableCodeIndexing: Yes\nUseSpacesForTab"
},
{
"path": "man/as.data.frame.compareClusterResult.Rd",
"chars": 457,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/data_utils.R\n\\name{as.data.frame.compareCl"
},
{
"path": "man/autofacet.Rd",
"chars": 552,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_utils.R\n\\name{autofacet}\n\\alias{autof"
},
{
"path": "man/barplot.enrichResult.Rd",
"chars": 1290,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/barplot.R\n\\name{barplot.enrichResult}\n\\ali"
},
{
"path": "man/cnetplot.Rd",
"chars": 3163,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/cnetplot.R\n\\name{cnetplot.enrichResult}\n\\a"
},
{
"path": "man/color_palette.Rd",
"chars": 428,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/color_utils.R\n\\name{color_palette}\n\\alias{"
},
{
"path": "man/dotplot.Rd",
"chars": 4674,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/dotplot.R\n\\name{dotplot}\n"
},
{
"path": "man/dotplot2.Rd",
"chars": 664,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/dotplot.R\n\\name{dotplot2}\n\\alias{dotplot2}"
},
{
"path": "man/emapplot.Rd",
"chars": 3686,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/emapplot.R\n\\name{emapplot"
},
{
"path": "man/enrichplot-common-params.Rd",
"chars": 960,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R\n\\name{enrichplot-common-para"
},
{
"path": "man/enrichplot-package.Rd",
"chars": 1013,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/enrichplot-package.R\n\\docType{package}\n\\na"
},
{
"path": "man/enrichplot-term-params.Rd",
"chars": 545,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R\n\\name{enrichplot-term-params"
},
{
"path": "man/enrichplot_point_shape.Rd",
"chars": 354,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/color_utils.R\n\\docType{data}\n\\name{enrichp"
},
{
"path": "man/fortify.Rd",
"chars": 1036,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/method-fortify.R\n\\name{fortify.compareClus"
},
{
"path": "man/geom_gsea_gene.Rd",
"chars": 700,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/gseaplot.R\n\\name{geom_gsea_gene}\n\\alias{ge"
},
{
"path": "man/get_enrichplot_color.Rd",
"chars": 415,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/color_utils.R\n\\name{get_enrichplot_color}\n"
},
{
"path": "man/ggtable.Rd",
"chars": 351,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/ggtable.R\n\\name{ggtable}\n\\alias{ggtable}\n\\"
},
{
"path": "man/goplot.Rd",
"chars": 1316,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/goplot.R\n\\name{goplot}\n\\a"
},
{
"path": "man/gsInfo.Rd",
"chars": 350,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/gseaplot.R\n\\name{gsInfo}\n\\alias{gsInfo}\n\\t"
},
{
"path": "man/gseadist.Rd",
"chars": 409,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/densityplot.R\n\\name{gseadist}\n\\alias{gsead"
},
{
"path": "man/gseaplot.Rd",
"chars": 1224,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/gseaplot.R\n\\name{gseaplot"
},
{
"path": "man/gseaplot2.Rd",
"chars": 1193,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/gseaplot.R\n\\name{gseaplot2}\n\\alias{gseaplo"
},
{
"path": "man/gsearank.Rd",
"chars": 498,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/gseaplot.R\n\\name{gsearank}\n\\alias{gsearank"
},
{
"path": "man/heatplot.Rd",
"chars": 1372,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/heatplot.R\n\\name{heatplot"
},
{
"path": "man/hplot.Rd",
"chars": 333,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/gseaplot.R\n\\name{hplot}\n\\alias{hplot}\n\\tit"
},
{
"path": "man/manhattanplot.Rd",
"chars": 2628,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/manhattanplot.R\n\\name{man"
},
{
"path": "man/pairwise_termsim.Rd",
"chars": 2786,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/pairwise_termsim.R\n\\name{"
},
{
"path": "man/plotting.clusterProfile.Rd",
"chars": 811,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/plot_utils.R\n\\name{plotting.clusterProfile"
},
{
"path": "man/pmcplot.Rd",
"chars": 451,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/pmcplot.R\n\\name{pmcplot}\n\\alias{pmcplot}\n\\"
},
{
"path": "man/reexports.Rd",
"chars": 909,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/reexport.R\n\\docType{import}\n\\name{reexport"
},
{
"path": "man/ridgeplot.Rd",
"chars": 1444,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/ridgeplot.R\n\\name{ridgepl"
},
{
"path": "man/set_enrichplot_color.Rd",
"chars": 827,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/color_utils.R\n\\name{set_enrichplot_color}\n"
},
{
"path": "man/ssplot.Rd",
"chars": 2277,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/ssplot.R\n\\name{ssplot}\n\\a"
},
{
"path": "man/treeplot.Rd",
"chars": 3870,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/treeplot.R\n\\name{treeplot"
},
{
"path": "man/upsetplot-methods.Rd",
"chars": 771,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/upsetplot.R\n\\docType{meth"
},
{
"path": "man/volplot.Rd",
"chars": 1464,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/AllGenerics.R, R/volplot.R\n\\name{volplot}\n"
},
{
"path": "vignettes/enrichplot.qmd",
"chars": 498,
"preview": "---\ntitle: \"Visualization of Functional Enrichment Result\"\nformat: \n html:\n theme: none\n embed-resource"
}
]
About this extraction
This page contains the full source code of the YuLab-SMU/enrichplot GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 79 files (260.0 KB), approximately 76.0k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.