├── .Rbuildignore ├── .gitignore ├── CONDUCT.md ├── DESCRIPTION ├── Makefile ├── NAMESPACE ├── NEWS.md ├── R ├── 00-AllClasses.R ├── AllGenerics.R ├── barplot.R ├── cnetplot.R ├── densityplot.R ├── dotplot.R ├── emapplot.R ├── emapplot_utilities.R ├── enrichplot-package.R ├── ggtable.R ├── goplot.R ├── gseaplot.R ├── heatplot.R ├── method-fortify.R ├── method-ggplot-add.R ├── method-print.r ├── pairwise_termsim.R ├── pmcplot.R ├── reexport.R ├── ridgeplot.R ├── show-method.R ├── ssplot.R ├── theme.R ├── treeplot.R ├── upsetplot.R ├── utilities.R ├── volplot.R ├── wordcloud.R └── zzz.R ├── README.Rmd ├── README.md ├── TODO.md ├── enrichplot.Rproj ├── man ├── autofacet.Rd ├── barplot.enrichResult.Rd ├── cnetplot.Rd ├── color_palette.Rd ├── dotplot.Rd ├── dotplot2.Rd ├── emapplot.Rd ├── enrichplot-package.Rd ├── fortify.Rd ├── geom_gsea_gene.Rd ├── ggtable.Rd ├── goplot.Rd ├── gsInfo.Rd ├── gseadist.Rd ├── gseaplot.Rd ├── gseaplot2.Rd ├── gsearank.Rd ├── heatplot.Rd ├── hplot.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.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | Makefile 4 | ^CONDUCT\.md$ 5 | README.Rmd 6 | README.md 7 | TODO.md 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | *.DS_Store 5 | *html 6 | 7 | .vscode/ 8 | Rplots* 9 | *.log 10 | -------------------------------------------------------------------------------- /CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Code of Conduct 2 | 3 | As contributors and maintainers of this project, we pledge to respect all people who 4 | contribute through reporting issues, posting feature requests, updating documentation, 5 | submitting pull requests or patches, and other activities. 6 | 7 | We are committed to making participation in this project a harassment-free experience for 8 | everyone, regardless of level of experience, gender, gender identity and expression, 9 | sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. 10 | 11 | Examples of unacceptable behavior by participants include the use of sexual language or 12 | imagery, derogatory comments or personal attacks, trolling, public or private harassment, 13 | insults, or other unprofessional conduct. 14 | 15 | Project maintainers have the right and responsibility to remove, edit, or reject comments, 16 | commits, code, wiki edits, issues, and other contributions that are not aligned to this 17 | Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed 18 | from the project team. 19 | 20 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by 21 | opening an issue or contacting one or more of the project maintainers. 22 | 23 | This Code of Conduct is adapted from the Contributor Covenant 24 | (http:contributor-covenant.org), version 1.0.0, available at 25 | http://contributor-covenant.org/version/1/0/0/ 26 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: enrichplot 2 | Title: Visualization of Functional Enrichment Result 3 | Version: 1.29.1 4 | Authors@R: c( 5 | person(given = "Guangchuang", family = "Yu", email = "guangchuangyu@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-6485-8781")), 6 | person(given = "Chun-Hui", family = "Gao", email = "gaospecial@gmail.com", role = "ctb", comment = c(ORCID = "0000-0002-1445-7939"))) 7 | Description: The 'enrichplot' package implements several visualization methods for interpreting functional enrichment results obtained from ORA or GSEA analysis. 8 | It is mainly designed to work with the 'clusterProfiler' package suite. All the visualization methods are developed based on 'ggplot2' graphics. 9 | Depends: R (>= 3.5.0) 10 | Imports: 11 | aplot (>= 0.2.1), 12 | DOSE (>= 3.31.2), 13 | ggfun (>= 0.1.7), 14 | ggnewscale, 15 | ggplot2, 16 | ggrepel (>= 0.9.0), 17 | ggtangle (>= 0.0.5), 18 | graphics, 19 | grid, 20 | igraph, 21 | methods, 22 | plyr, 23 | purrr, 24 | RColorBrewer, 25 | reshape2, 26 | rlang, 27 | stats, 28 | utils, 29 | scatterpie, 30 | GOSemSim (>= 2.31.2), 31 | magrittr, 32 | ggtree, 33 | yulab.utils (>= 0.1.6) 34 | Suggests: 35 | clusterProfiler, 36 | dplyr, 37 | europepmc, 38 | ggarchery, 39 | ggupset, 40 | glue, 41 | knitr, 42 | rmarkdown, 43 | org.Hs.eg.db, 44 | prettydoc, 45 | tibble, 46 | tidyr, 47 | ggforce, 48 | ggHoriPlot, 49 | AnnotationDbi, 50 | ggplotify, 51 | ggridges, 52 | grDevices, 53 | gridExtra, 54 | ggstar, 55 | scales, 56 | ggtreeExtra, 57 | tidydr 58 | Remotes: 59 | YuLab-SMU/tidydr 60 | VignetteBuilder: knitr 61 | License: Artistic-2.0 62 | URL: https://yulab-smu.top/contribution-knowledge-mining/ 63 | BugReports: https://github.com/GuangchuangYu/enrichplot/issues 64 | biocViews: Annotation, GeneSetEnrichment, GO, KEGG, 65 | Pathways, Software, Visualization 66 | Encoding: UTF-8 67 | RoxygenNote: 7.3.2 68 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PKGNAME := $(shell sed -n "s/Package: *\([^ ]*\)/\1/p" DESCRIPTION) 2 | PKGVERS := $(shell sed -n "s/Version: *\([^ ]*\)/\1/p" DESCRIPTION) 3 | PKGSRC := $(shell basename `pwd`) 4 | BIOCVER := RELEASE_3_21 5 | 6 | 7 | all: rd check clean 8 | 9 | for-release: rd check-dontrun clean readme 10 | 11 | alldocs: rd 12 | 13 | rd: 14 | Rscript -e 'roxygen2::roxygenise(".")' 15 | 16 | readme: 17 | Rscript -e 'rmarkdown::render("README.Rmd")' 18 | 19 | build: 20 | # cd ..;\ 21 | # R CMD build $(PKGSRC) 22 | Rscript -e 'devtools::build()' 23 | 24 | build2: 25 | cd ..;\ 26 | R CMD build --no-build-vignettes $(PKGSRC) 27 | 28 | install: 29 | cd ..;\ 30 | R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz 31 | 32 | check: 33 | # cd ..;\ 34 | # Rscript -e 'rcmdcheck::rcmdcheck("$(PKGNAME)_$(PKGVERS).tar.gz")' 35 | Rscript -e 'devtools::check()' 36 | 37 | check-dontrun: build 38 | cd ..;\ 39 | Rscript -e 'rcmdcheck::rcmdcheck("$(PKGNAME)_$(PKGVERS).tar.gz", args=c("--run-dontrun"))' 40 | 41 | 42 | check2: build 43 | cd ..;\ 44 | R CMD check $(PKGNAME)_$(PKGVERS).tar.gz 45 | 46 | bioccheck: 47 | cd ..;\ 48 | Rscript -e 'BiocCheck::BiocCheck("$(PKGNAME)_$(PKGVERS).tar.gz")' 49 | 50 | 51 | clean: 52 | cd ..;\ 53 | $(RM) -r $(PKGNAME).Rcheck/ 54 | 55 | rmrelease: 56 | git branch -D $(BIOCVER) 57 | 58 | release: 59 | git checkout $(BIOCVER);\ 60 | git fetch --all 61 | 62 | update: 63 | git fetch --all;\ 64 | git checkout devel;\ 65 | git merge upstream/devel;\ 66 | git merge origin/devel 67 | 68 | push: 69 | git push upstream devel;\ 70 | git push origin devel 71 | 72 | biocinit: 73 | git remote add upstream git@git.bioconductor.org:packages/$(PKGNAME).git;\ 74 | git fetch --all 75 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(as.data.frame,compareClusterResult) 4 | S3method(barplot,compareClusterResult) 5 | S3method(barplot,enrichResult) 6 | S3method(cnetplot,compareClusterResult) 7 | S3method(cnetplot,enrichResult) 8 | S3method(cnetplot,gseaResult) 9 | S3method(fortify,compareClusterResult) 10 | S3method(fortify,enrichResult) 11 | S3method(fortify,gseaResult) 12 | S3method(ggplot_add,autofacet) 13 | S3method(print,enrichplotDot) 14 | export(autofacet) 15 | export(cnetplot) 16 | export(color_palette) 17 | export(dotplot) 18 | export(dotplot2) 19 | export(emapplot) 20 | export(facet_grid) 21 | export(geom_cnet_label) 22 | export(geom_gsea_gene) 23 | export(ggtable) 24 | export(ggtitle) 25 | export(goplot) 26 | export(gseadist) 27 | export(gseaplot) 28 | export(gseaplot2) 29 | export(gsearank) 30 | export(heatplot) 31 | export(hplot) 32 | export(plot_list) 33 | export(pmcplot) 34 | export(ridgeplot) 35 | export(set_enrichplot_color) 36 | export(ssplot) 37 | export(treeplot) 38 | export(upsetplot) 39 | export(volplot) 40 | exportMethods(dotplot) 41 | exportMethods(emapplot) 42 | exportMethods(goplot) 43 | exportMethods(gseaplot) 44 | exportMethods(heatplot) 45 | exportMethods(pairwise_termsim) 46 | exportMethods(ridgeplot) 47 | exportMethods(ssplot) 48 | exportMethods(treeplot) 49 | exportMethods(upsetplot) 50 | exportMethods(volplot) 51 | import(GOSemSim) 52 | importClassesFrom(DOSE,compareClusterResult) 53 | importFrom(DOSE,geneID) 54 | importFrom(DOSE,geneInCategory) 55 | importFrom(DOSE,theme_dose) 56 | importFrom(RColorBrewer,brewer.pal) 57 | importFrom(aplot,plot_list) 58 | importFrom(ggplot2,"%+%") 59 | importFrom(ggplot2,aes) 60 | importFrom(ggplot2,aes_) 61 | importFrom(ggplot2,aes_string) 62 | importFrom(ggplot2,annotation_custom) 63 | importFrom(ggplot2,coord_cartesian) 64 | importFrom(ggplot2,coord_equal) 65 | importFrom(ggplot2,coord_fixed) 66 | importFrom(ggplot2,coord_flip) 67 | importFrom(ggplot2,element_blank) 68 | importFrom(ggplot2,element_line) 69 | importFrom(ggplot2,element_rect) 70 | importFrom(ggplot2,element_text) 71 | importFrom(ggplot2,facet_grid) 72 | importFrom(ggplot2,fortify) 73 | importFrom(ggplot2,geom_bar) 74 | importFrom(ggplot2,geom_blank) 75 | importFrom(ggplot2,geom_boxplot) 76 | importFrom(ggplot2,geom_col) 77 | importFrom(ggplot2,geom_density) 78 | importFrom(ggplot2,geom_hline) 79 | importFrom(ggplot2,geom_jitter) 80 | importFrom(ggplot2,geom_line) 81 | importFrom(ggplot2,geom_linerange) 82 | importFrom(ggplot2,geom_point) 83 | importFrom(ggplot2,geom_rect) 84 | importFrom(ggplot2,geom_segment) 85 | importFrom(ggplot2,geom_text) 86 | importFrom(ggplot2,geom_tile) 87 | importFrom(ggplot2,geom_violin) 88 | importFrom(ggplot2,geom_vline) 89 | importFrom(ggplot2,ggplot) 90 | importFrom(ggplot2,ggplotGrob) 91 | importFrom(ggplot2,ggplot_add) 92 | importFrom(ggplot2,ggplot_build) 93 | importFrom(ggplot2,ggplot_gtable) 94 | importFrom(ggplot2,ggtitle) 95 | importFrom(ggplot2,guide_colorbar) 96 | importFrom(ggplot2,guide_legend) 97 | importFrom(ggplot2,guides) 98 | importFrom(ggplot2,labs) 99 | importFrom(ggplot2,margin) 100 | importFrom(ggplot2,rel) 101 | importFrom(ggplot2,scale_color_continuous) 102 | importFrom(ggplot2,scale_color_gradient) 103 | importFrom(ggplot2,scale_color_gradientn) 104 | importFrom(ggplot2,scale_color_manual) 105 | importFrom(ggplot2,scale_colour_continuous) 106 | importFrom(ggplot2,scale_fill_continuous) 107 | importFrom(ggplot2,scale_fill_discrete) 108 | importFrom(ggplot2,scale_fill_gradient2) 109 | importFrom(ggplot2,scale_fill_gradientn) 110 | importFrom(ggplot2,scale_fill_manual) 111 | importFrom(ggplot2,scale_size) 112 | importFrom(ggplot2,scale_size_continuous) 113 | importFrom(ggplot2,scale_x_continuous) 114 | importFrom(ggplot2,scale_x_reverse) 115 | importFrom(ggplot2,scale_y_continuous) 116 | importFrom(ggplot2,scale_y_discrete) 117 | importFrom(ggplot2,theme) 118 | importFrom(ggplot2,theme_bw) 119 | importFrom(ggplot2,theme_classic) 120 | importFrom(ggplot2,theme_minimal) 121 | importFrom(ggplot2,theme_void) 122 | importFrom(ggplot2,xlab) 123 | importFrom(ggplot2,xlim) 124 | importFrom(ggplot2,ylab) 125 | importFrom(ggrepel,geom_label_repel) 126 | importFrom(ggrepel,geom_text_repel) 127 | importFrom(ggtangle,cnetplot) 128 | importFrom(ggtangle,geom_cnet_label) 129 | importFrom(ggtangle,geom_edge) 130 | importFrom(ggtree,"%<+%") 131 | importFrom(ggtree,geom_cladelab) 132 | importFrom(ggtree,geom_inset) 133 | importFrom(ggtree,geom_tiplab) 134 | importFrom(ggtree,geom_tippoint) 135 | importFrom(ggtree,ggtree) 136 | importFrom(ggtree,groupClade) 137 | importFrom(ggtree,nodepie) 138 | importFrom(graphics,barplot) 139 | importFrom(grid,arrow) 140 | importFrom(grid,gpar) 141 | importFrom(grid,unit) 142 | importFrom(igraph,'E<-') 143 | importFrom(igraph,'V<-') 144 | importFrom(igraph,E) 145 | importFrom(igraph,V) 146 | importFrom(igraph,add_vertices) 147 | importFrom(igraph,delete.edges) 148 | importFrom(igraph,graph.empty) 149 | importFrom(igraph,graph_from_data_frame) 150 | importFrom(magrittr,"%>%") 151 | importFrom(methods,is) 152 | importFrom(methods,setGeneric) 153 | importFrom(methods,setOldClass) 154 | importFrom(plyr,.) 155 | importFrom(plyr,ddply) 156 | importFrom(plyr,mdply) 157 | importFrom(purrr,map_df) 158 | importFrom(rlang,.data) 159 | importFrom(rlang,check_installed) 160 | importFrom(stats,quantile) 161 | importFrom(stats,setNames) 162 | importFrom(utils,data) 163 | importFrom(utils,getFromNamespace) 164 | importFrom(utils,modifyList) 165 | importFrom(yulab.utils,str_wrap) 166 | importFrom(yulab.utils,yulab_msg) 167 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # enrichplot 1.29.1 2 | 3 | + throw error in `goplot()` if ontology is not one of the 'MF', 'CC' or 'BF' (2025-04-28, Mon, clusterProfiler#768) 4 | 5 | # enrichplot 1.28.0 6 | 7 | + Bioconductor RELEASE_3_21 (2025-04-17, Thu) 8 | 9 | # enrichplot 1.27.5 10 | 11 | + able to scale pie size for 'compareClusterResult' (2025-03-11, Tue, #308, #311) 12 | 13 | # enrichplot 1.27.4 14 | 15 | + adjust pie size and category label position in `cnetplot()` (2025-01-08, Wed, #306) 16 | + clean up code (2024-12-20, Fri) 17 | 18 | # enrichplot 1.27.3 19 | 20 | + scale pies and add pie legend in `emapplot()` (2024-12-12, Thu, #304) 21 | + a safe way to extract gene sets in `ridgeplot()` (2024-12-12, Thu, #303) 22 | 23 | # enrichplot 1.27.2 24 | 25 | + `emapplot()` now allows passing color to a specific color, e.g., color = "black" (2024-11-29, Fri, #300) 26 | + bug fixed in `emapplot()` 27 | - `size_category` now works for pie node (2024-11-29, Fri, #301) 28 | - legend of term nodes will be retained when `group = TRUE` (2024-11-29, Fri, #300) 29 | + supports passing ID to 'showCategory' in `ridgeplot()` (2024-11-06, Wed, #295) 30 | + enhancement of `cnetplot()` (2024-11-06, Wed) 31 | - 'node_label' can be a vector of selected items/genes to specify the items to be displayed (#293) 32 | - 'node_label' can be 'exclusive' to label genes that are uniquely belongs to categories (#253) 33 | - 'node_label' can be 'share' to label genes that are share between categories (#253) 34 | - 'node_label' can be, e.g. '> 1' or '< 1', to label genes that have log2FC values larger or smaller than the threshold (#253) 35 | - supports using `ggtangle::geom_cnet_label()` to label items/genes in independent layer (#194, #266, #267) 36 | + fixed `ridgeplot()` when selecting a specific gene set and plotting non-core genes (2024-11-06, Wed, #298) 37 | 38 | # enrichplot 1.27.1 39 | 40 | + add 'ID' parameter in `goplot()` (2024-10-30, Wed) 41 | - 42 | 43 | # enrichplot 1.26.0 44 | 45 | + Bioconductor RELEASE_3_20 (2024-10-30, Wed) 46 | 47 | # enrichplot 1.25.6 48 | 49 | + pretty gene count legend (2024-10-29, Tue, #271) 50 | 51 | # enrichplot 1.25.5 52 | 53 | + new `emaplot()`, `goplot()`, `cnetplot()` and `ssplot()`, all power by 'ggtangle' package (2024-10-24, Thu) 54 | + re-export `ggtangle::cnetplot()` (2024-10-24, Thu) 55 | + remove `drag_network()` (2024-10-24, Thu) 56 | 57 | # enrichplot 1.25.4 58 | 59 | + fixed `goplot()` (2024-10-23, Wed, #297, #732, #718) 60 | 61 | # enrichplot 1.25.3 62 | 63 | + `hplot()`: Horizontal plot for GSEA result (2024-08-27, Tue) 64 | 65 | # enrichplot 1.25.2 66 | 67 | + fixed bug in `ridgeplot()` (2024-08-19, Mon, clusterProfiler#704) 68 | 69 | # enrichplot 1.25.1 70 | 71 | + fixed GeneRatio in dotplot as character of fraction issue (2024-08-16, Fri, clusterProfiler#715) 72 | + use `yulab.utils::yulab_msg()` for startup message (2024-07-26, Fri) 73 | + `dotplot2` to compare two selected clusters in 'compareClusterResult' object (2024-06-15, Sat) 74 | + `volplot` to visualize ORA result using volcano plot (2024-06-13, Thu) 75 | 76 | # enrichplot 1.24.0 77 | 78 | + Bioconductor RELEASE_3_19 (2024-05-15, Wed) 79 | 80 | # enrichplot 1.23.2 81 | 82 | + separate the JC similarity method (2023-12-11, Mon, #265) 83 | + fix the issue in `ridgeplot(showCategory)` : support a vector of Description, not ID(2023-12-1, Fri, #193) 84 | 85 | # enrichplot 1.23.1 86 | 87 | + `ridgeplot()` supports passing a vector of selected pathways via the 'showCategory' parameter (2023-11-30, Thu, #193) 88 | + fix `treeplot()` to compatible with the current version of ggtree and ggtreeExtra. (2023-10-28, Sat) 89 | + add clusterPanel.params[["colnames_angle"]] parameter to set the angle of colnames. (2023-10-28, Sat) 90 | 91 | # enrichplot 1.22.0 92 | 93 | + Bioconductor RELEASE_3_18 (2023-10-25, Wed) 94 | 95 | # enrichplot 1.21.3 96 | 97 | + `set_enrichplot_color()`, a helper function to set colors (2023-09-13, Wed) 98 | - change default color: from c("red", "blue") to c("#e06663", "#327eba") 99 | + use `check_installed()` to check package dependency (2023-09-08, Fri, #254) 100 | 101 | # enrichplot 1.21.2 102 | 103 | + 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) 104 | 105 | # enrichplot 1.21.1 106 | 107 | + fixed `cnetplot.compareClusterResult()` for only contains one cluster (2023-05-24, Wed, #243) 108 | 109 | # enrichplot 1.20.0 110 | 111 | + Bioconductor RELEASE_3_17 (2023-05-03, Wed) 112 | 113 | # enrichplot 1.19.2 114 | 115 | + fix `emapplot()` for parameter mismatch (2023-02-20, Mon) 116 | + fix `ridgeplot` for error when x@readable == TRUE and length(x@gene2Symbol) = 0 (2022-12-5, Mon) 117 | + fix `ridgeplot` for error when `x@readable == TRUE` and `length(x@gene2Symbol) = 0` (2022-12-5, Mon, #217) 118 | 119 | # enrichplot 1.19.1 120 | 121 | + fix `cnetplot()` for `node_label` parameter is flipped(2022-12-04, Sun, #216) 122 | + bug fixed in `treeplot()` (2022-11-18, Fri) 123 | + enable `dotplot()` and `autofacet()` for `gseaResultList` object 124 | 125 | # enrichplot 1.18.0 126 | 127 | + Bioconductor RELEASE_3_16 (2022-11-02, Wed) 128 | 129 | # enrichplot 1.17.4 130 | 131 | + rename parameters of `emapplot()`, `centplot()` and `treeplot()` (2022-09-11, Sun) 132 | 133 | # enrichplot 1.17.3 134 | 135 | + align the dots in `treeplot()` (2022-10-1, Sat) 136 | + fix a bug in color legend of `treeplot()` (2022-10-1, Sat) 137 | 138 | # enrichplot 1.17.2 139 | 140 | + `autofacet` to automatically split `barplot` and `dotplot` into several facets (2022-09-06, Tue) 141 | + `dotplot` method for `enrichResultList` object 142 | + add parameters `hilight_category`, `alpha_hilight`, `alpha_nohilight` for `cnetplot()` and `emapplot` (2022-09-4, Sun) 143 | + change round digits of cnetplot scatterpie legend to 1 (2022_8_29, Mon). 144 | + `gsearank()` can export result as a table when `output = "table"` (2022-08-29, Mon, #184) 145 | + fix a bug in `fc_readable()` (2022-08-29, Mon, #189) 146 | + allows passing `color="NES"` to `dotplot()` for `gseaResult` object (2022-08-29, Mon, #14) 147 | 148 | # enrichplot 1.17.1 149 | 150 | + fix a bug in https://github.com/YuLab-SMU/clusterProfiler/issues/488 (2022-08-25, Thu) 151 | + support multiple gene sets in `geom_gsea_gene` layer (2022-08-25, Thu) 152 | + `geom_gsea_gene` layer (2022-08-24, Wed) 153 | + add parameters `symbol` and `pvalue` for `heatplot.enrichResult()` (2022-08-20, Sat) 154 | + change default values of `group_category` and `node_label` in `ssplot()` (2022-07-04, Mon) 155 | + update document of `ssplot()` (2022-07-04, Mon) 156 | + `gseaplot()` and `gseaplot2()` return `gglist` object instead of plotting the figure (2022-05-05, Thu) 157 | + fix `ridgeplot` when `x@readable = TRUE` (2022-04-30, Sat) 158 | 159 | # enrichplot 1.16.0 160 | 161 | + Bioconductor 3.15 release 162 | 163 | # enrichplot 1.15.4 164 | 165 | + update `treeplot`: support passing rel object to `offset` and `offset_tiplab` (2022-04-24, Sun) 166 | 167 | # enrichplot 1.15.3 168 | 169 | + export `drag_network' (2022-03-07, Mon) 170 | + update `cnetplot.enrichResult` to be supported by `drag_network`(2022-3-6, Sun) 171 | + add function `drag_network` to drag the nodes of networks (2022-2-25, Fri) 172 | + fix a bug in `goplot`: `goplot.gseaResult` need `setType` slot instead of `ontology` slot (2022-2-22, Tue) 173 | + return `gg` object instead of print it in `dotplot.compareClusterResult()` (2022-01-05, Wed, @altairwei, #160) 174 | 175 | # enrichplot 1.15.2 176 | 177 | + add `label_format_tiplab` and `label_format_cladelab` parameters for `treeplot`(2021-12-24, Fri) 178 | + support treeplot of compareCluster(GSEA algorithm) result(2021-12-13, Mon) 179 | + support visualization of compareCluster(GSEA algorithm) result(2021-12-11, Sat) 180 | + support scientific notation for `gseaplot2`(2021-12-4, Sat) 181 | 182 | # enrichplot 1.15.1 183 | 184 | + fixed R check by importing `utils` 185 | 186 | # enrichplot 1.14.0 187 | 188 | + Bioconductor 3.14 release 189 | 190 | # enrichplot 1.13.2 191 | 192 | + mv `ep_str_wrap` to `yulab.utils::str_wrap` (2021-10-13, Wed) 193 | + adjust the order of legends for `dotplot`, `emapplot`, `cnetplot` and `treeplot`(2021-10-8, Fri) 194 | + update `treeplot`: add "dotplot" and "heatmap" panels for `treeplot`(2021-9-15, Wed) 195 | + update `dotplot`: enable `size` parameter applicable to other columns of compareClusterResult(2021-9-17, Fri) 196 | + enable `label_format` parameter for `heatplot` (2021-09-01, Wed) 197 | + add `get_ggrepel_segsize` function to set `segment.size` value for `ggrepel`(2021-08-29, Sun) 198 | + update `ep_str_wrap` (2021-08-28, Sat) 199 | + `cnetplot` now works with a named list (2021-08-23, Mon; clusterProfiler#362) 200 | 201 | # enrichplot 1.13.1 202 | 203 | + use `aplot::plot_list` instead of `cowplot::plot_grid` (2021-06-13, Sun 204 | + add `color_category` and `color_gene` parameters for `cnetplot`(2021-6-11, Fri) 205 | + Enables `showCategory` parameter to support character input in `dotplot.compareClusterResult`(2021-6-10, Thu) 206 | 207 | # enrichplot 1.12.0 208 | 209 | + Bioconductor 3.13 release 210 | 211 | # enrichplot 1.11.3 212 | 213 | + add function `ssplot` for similarity space plot. (2021-4-22, Thu). 214 | + Reconstruct the `emapplot` function and replace `emapplot_cluster` by `emapplot(group_category = TRUE)` 215 | + fix bug in `emapplot_cluster.enrichResult` when the number of cluster is 2 (2021-2-24, Wed). 216 | + fix bug in `treeplot`: The legend is not the right size (2021-2-6, Sat). 217 | + fix `dotplot` for `label_format` parameter doesn't work(2021-2-3, Wed). 218 | + fix bug in `gseaplot2`(2021-1-28, Thu) 219 | 220 | # enrichplot 1.11.2 221 | 222 | + update document (2021-1-7, Thu) 223 | + update `dotplot`: replace `ggsymbol::geom_symbol` with `ggstar::geom_star`(2021-1-6, Wed) 224 | + add parameter `shadowtext` for three functions: `emapplot`, `emapplot_cluster` and `cnetplot`. (2021-1-5, Tue) 225 | + update `dotplot`: supports the use of shapes and line colors to distinguish groups (2021-1-3, Sun) 226 | + add `treeplot` function (2020-12-29, Tue) 227 | + rename function `get_ww` to `get_similarity_matrix` (2020-12-29, Tue) 228 | + move the `emapplot` related functions to emapplot_utilities.R 229 | + fix bug in `emapplot` and `cnetplot` when enrichment result is one line (2020-12-26, Sat) 230 | + fix `pairwise_termsim` for the bug of repeated filtering of `showCategory`(2020-12-23, Wed) 231 | + fix `showCategory` for `cnetplot`, `emapplot`, `emapplot_cluster` when `showCategory` is a vector of term descriptions 232 | 233 | 234 | # enrichplot 1.11.1 235 | 236 | + add `orderBy` and `decreasing` parameters for `ridgeplot()` (2020-11-19, Thu) 237 | - 238 | + update `emapplot_cluster()` to label cluster in center by default and use `ggrepel` if setting `repel = TRUE` (2020-11-08, Mon) 239 | - 240 | + add a `label_format` parameter to support formatting label (2020-10-28, Wed) 241 | + if provided with a numeric value will simply string wrap by default 242 | + if provided with a function will instead set labels = user_defined_function() within the scale function 243 | + 244 | 245 | # enrichplot 1.10.0 246 | 247 | + Bioconductor 3.12 release (2020-10-28, Wed) 248 | 249 | # enrichplot 1.9.5 250 | 251 | + fix `wordcloud_i` (2020-10-15, Thu) 252 | + Remove similarity calculation from emapplot 253 | 254 | # enrichplot 1.9.4 255 | 256 | + implement `pairwise_termsim` to calculate similarity of enriched terms (2020-10-09, Fri) 257 | - 258 | + change parameters to be more consistent 259 | - 260 | 261 | # enrichplot 1.9.3 262 | 263 | + add `node_label_size` parameter to adjust the size of node label in `emapplot` function (2020-09-18, Fri) 264 | 265 | # enrichplot 1.9.2 266 | 267 | + add function `emapplot_cluster` (2020-09-01, Tue) 268 | 269 | 270 | # enrichplot 1.7.3 271 | 272 | + update `barplot` to remove using `coord_flip()` (2020-09-10, Thu) 273 | + update `cnetplot` color scale to tolerate with skewed foldchange (2020-03-13, Fri) 274 | - 275 | 276 | # enrichplot 1.7.1 277 | 278 | + `cnetplot` for `compareClusterResult` (`compareCluster` output) (2019-12-02, Mon) 279 | + move `barplot`, `dotplot` and `fortify` methods of `compareClusterResult` from `clusterProfiler` (2019-11-2, Sat) 280 | 281 | # enrichplot 1.6.0 282 | 283 | + Bioconductor 3.10 release 284 | 285 | # enrichplot 1.5.2 286 | 287 | + update `node_label` parameter in `cnetplot` to support selection of subset to be labeled (2019-09-27, Fri) 288 | - 289 | + `upsetplot` for `gseaResult` (2019-09-25, Wed) 290 | + reimplement `upsetplot` based on `ggupset` 291 | 292 | # enrichplot 1.5.1 293 | 294 | + `gseadist` for plotting logFC distribution of selected gene sets. (2019-06-25, Tue) 295 | 296 | # enrichplot 1.4.0 297 | 298 | + Bioconductor 3.9 release 299 | 300 | # enrichplot 1.3.2 301 | 302 | + `dotplot` supports setting `x` to other variable, e.g. NES (2019-01-10, Thu) 303 | + mv vignette to [clusterProfiler-book](https://yulab-smu.github.io/clusterProfiler-book/). 304 | 305 | # enrichplot 1.2.0 306 | 307 | + Bioconductor 3.8 release 308 | 309 | # enrichplot 1.1.5 310 | 311 | + `gsearank` for plotting ranked list of genes belong to specific gene set 312 | (2018-07-04, Wed) 313 | 314 | # enrichplot 1.1.4 315 | 316 | + `base_size` parameter in `gseaplot2` (2018-06-21, Thu) 317 | 318 | # enrichplot 1.1.3 319 | 320 | + `pmcplot` for plotting pubmed trend (2018-06-14, Thu) 321 | + `ggtable` for plotting table 322 | + `gseaplot2` now accepts a vector of `geneSetID` (2018-06-13, Wed) 323 | 324 | # enrichplot 1.1.2 325 | 326 | + `emapplot` supports `showCategory` parameter to accept a vector of 327 | `Description` (2018-05-29, Tue) 328 | + bug fixed of `showCategory` parameter for vector of `Description` in 329 | `cnetplot` 330 | - 331 | + `gseaplot2` that mimic the figure generated by broad institute's GSEA software 332 | (2018-05-28, Mon) 333 | 334 | # enrichplot 1.1.1 335 | 336 | + `cnetplot` supports `showCategory` parameter to accept a vector of 337 | `Description` 338 | - 339 | 340 | # enrichplot 1.0.0 341 | 342 | + Bioconductor 3.7 release 343 | 344 | # enrichplot 0.99.14 345 | 346 | + `node_label = TRUE` parameter in `cnetplot` (2018-04-08, Sun 347 | ) 348 | + drop NA in `dotplot` <2018-03-19, Mon> 349 | - 350 | + enable using formula to specify x axis in `dotplot` 351 | 352 | # enrichplot 0.99.13 353 | 354 | + fixed `goplot` issue by imporint `ggraph` <2018-03-12, Mon> 355 | - 356 | 357 | - >Error in grid.Call(C_convert, x, as.integer(whatfrom), as.integer(whatto), : 358 | >invalid line type 359 | + `dotplot` now supports `orderBy` and `decreasing` parameters to specify the order of dots by `order(x[[orderBy]], decreasing=decreasing)` 360 | 361 | 362 | # enrichplot 0.99.9 363 | 364 | + defined `upsetplot` (2018-01-30, Tue) 365 | + all visualization methods were defined as `S4` methods (2018-01-29, Mon) 366 | 367 | # enrichplot 0.99.5 368 | 369 | + defined all visualization functions as generic functions (2018-01-03, Wed) 370 | + add `colorEdge` parameter in `cnetplot` 371 | + update docs 372 | 373 | enrichplot 0.99.3 374 | ------------------------ 375 | + import `ggplot2::rel` to fix R check (2017-11-28, Tue) 376 | 377 | enrichplot 0.99.0 378 | ------------------------ 379 | + ready to submit to Bioconductor (2017-11-28, Tue) 380 | 381 | enrichplot 0.0.3 382 | ------------------------ 383 | + `heatplot` and `gseaplot` (2017-11-28, Tue) 384 | + `ridgeplot`, `barplot` and `dotplot` derived from `DOSE` (2017-11-28, Tue) 385 | + `cnetplot` (2017-11-28, Tue) 386 | 387 | enrichplot 0.0.2 388 | ------------------------ 389 | + vignette added (2017-11-28, Tue) 390 | + `goplot` for plotting induced GO DAG (2017-11-27, Mon) 391 | 392 | enrichplot 0.0.1 393 | ------------------------ 394 | + `emapplot` for plotting enrichment map (2017-11-23) 395 | -------------------------------------------------------------------------------- /R/00-AllClasses.R: -------------------------------------------------------------------------------- 1 | ##' @importFrom methods setOldClass 2 | setOldClass("enrichResultList") 3 | setOldClass("gseaResultList") 4 | -------------------------------------------------------------------------------- /R/AllGenerics.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | ##' dotplot for enrichment result 4 | ##' 5 | ##' 6 | ##' @title dotplot 7 | ##' @rdname dotplot 8 | ##' @param object input object 9 | ##' @param ... additional parameters 10 | ##' @return plot 11 | ##' @importFrom methods setGeneric 12 | ##' @export 13 | ##' @examples 14 | ##' \dontrun{ 15 | ##' library(DOSE) 16 | ##' data(geneList) 17 | ##' de <- names(geneList)[1:100] 18 | ##' x <- enrichDO(de) 19 | ##' dotplot(x) 20 | ##' # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. 21 | ##' dotplot(x, showCategory = 10) 22 | ##' categorys <- c("pre-malignant neoplasm", "intestinal disease", 23 | ##' "breast ductal carcinoma", "non-small cell lung carcinoma") 24 | ##' dotplot(x, showCategory = categorys) 25 | ##' # It can also graph compareClusterResult 26 | ##' data(gcSample) 27 | ##' library(clusterProfiler) 28 | ##' library(DOSE) 29 | ##' library(org.Hs.eg.db) 30 | ##' data(gcSample) 31 | ##' xx <- compareCluster(gcSample, fun="enrichGO", OrgDb="org.Hs.eg.db") 32 | ##' xx2 <- pairwise_termsim(xx) 33 | ##' library(ggstar) 34 | ##' dotplot(xx2) 35 | ##' dotplot(xx2, shape = TRUE) 36 | ##' dotplot(xx2, group = TRUE) 37 | ##' dotplot(xx2, x = "GeneRatio", group = TRUE, size = "count") 38 | ##' } 39 | ##' @author Guangchuang Yu 40 | setGeneric("dotplot", 41 | function(object, ...) 42 | standardGeneric("dotplot") 43 | ) 44 | 45 | ##' Enrichment Map for enrichment result of 46 | ##' over-representation test or gene set enrichment analysis 47 | ##' 48 | ##' 49 | ##' This function visualizes gene sets as a network (i.e. enrichment map). 50 | ##' Mutually overlapping gene sets tend to cluster together, making it 51 | ##' easier for interpretation. When the similarity between terms meets 52 | ##' a certain threshold (default is 0.2, adjusted by parameter `min_edge`), 53 | ##' there will be edges between terms. The stronger the similarity, 54 | ##' the shorter and thicker the edges. The similarity between terms is 55 | ##' obtained by function `pairwise_termsim`, the details of similarity 56 | ##' calculation can be found in its documentation: \link{pairwise_termsim}. 57 | ##' @title emapplot 58 | ##' @rdname emapplot 59 | ##' @param x Enrichment result. 60 | ##' @param showCategory A number or a vector of terms. If it is a number, 61 | ##' the first n terms will be displayed. If it is a vector of terms, 62 | ##' the selected terms will be displayed. 63 | ##' @param ... Additional parameters 64 | ##' @return ggplot object 65 | ##' @export 66 | ##' @examples 67 | ##' \dontrun{ 68 | ##' library(DOSE) 69 | ##' data(geneList) 70 | ##' de <- names(geneList)[1:100] 71 | ##' x <- enrichDO(de) 72 | ##' x2 <- pairwise_termsim(x) 73 | ##' emapplot(x2) 74 | ##' # use `layout` to change the layout of map 75 | ##' emapplot(x2, layout = "star") 76 | ##' # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. 77 | ##' emapplot(x2, showCategory = 10) 78 | ##' categorys <- c("pre-malignant neoplasm", "intestinal disease", 79 | ##' "breast ductal carcinoma") 80 | ##' emapplot(x2, showCategory = categorys) 81 | ##' 82 | ##' # It can also graph compareClusterResult 83 | ##' library(clusterProfiler) 84 | ##' library(DOSE) 85 | ##' library(org.Hs.eg.db) 86 | ##' data(gcSample) 87 | ##' xx <- compareCluster(gcSample, fun="enrichGO", OrgDb="org.Hs.eg.db") 88 | ##' xx2 <- pairwise_termsim(xx) 89 | ##' emapplot(xx2) 90 | ##' } 91 | ##' @author Guangchuang Yu 92 | setGeneric("emapplot", 93 | function(x, ...) 94 | standardGeneric("emapplot") 95 | ) 96 | 97 | 98 | 99 | 100 | ##' Get the similarity matrix 101 | ##' 102 | ##' 103 | ##' This function add similarity matrix to the termsim slot of enrichment result. 104 | ##' Users can use the `method` parameter to select the method of calculating similarity. 105 | ##' The Jaccard correlation coefficient(JC) is used by default, and it applies to all situations. 106 | ##' When users want to calculate the correlation between GO terms or DO terms, they can also choose 107 | ##' "Resnik", "Lin", "Rel" or "Jiang" (they are semantic similarity calculation methods from GOSemSim packages), 108 | ##' and at this time, the user needs to provide `semData` parameter, which can be obtained through 109 | ##' \link{godata} function in GOSemSim package. 110 | ##' @title pairwise_termsim 111 | ##' @rdname pairwise_termsim 112 | ##' @param x enrichment result. 113 | ##' @param method method of calculating the similarity between nodes, 114 | ##' one of "Resnik", "Lin", "Rel", "Jiang" , "Wang" and 115 | ##' "JC"(Jaccard similarity coefficient) methods. 116 | ##' @param semData GOSemSimDATA object, can be obtained through 117 | ##' \link{godata} function in GOSemSim package. 118 | ##' @param showCategory number of enriched terms to display, default value is 200. 119 | ##' @examples 120 | ##' \dontrun{ 121 | ##' library(clusterProfiler) 122 | ##' library(org.Hs.eg.db) 123 | ##' library(enrichplot) 124 | ##' library(GOSemSim) 125 | ##' library(DOSE) 126 | ##' data(geneList) 127 | ##' gene <- names(geneList)[abs(geneList) > 2] 128 | ##' ego <- enrichGO(gene = gene, 129 | ##' universe = names(geneList), 130 | ##' OrgDb = org.Hs.eg.db, 131 | ##' ont = "BP", 132 | ##' pAdjustMethod = "BH", 133 | ##' pvalueCutoff = 0.01, 134 | ##' qvalueCutoff = 0.05, 135 | ##' readable = TRUE) 136 | ##' d <- godata('org.Hs.eg.db', ont="BP") 137 | ##' ego2 <- pairwise_termsim(ego, method="Wang", semData = d) 138 | ##' emapplot(ego2) 139 | ##' emapplot_cluster(ego2) 140 | ##' } 141 | setGeneric("pairwise_termsim", 142 | function(x, method = "JC", semData = NULL, showCategory = 200) 143 | standardGeneric("pairwise_termsim") 144 | ) 145 | 146 | ##' plot induced GO DAG of significant terms 147 | ##' 148 | ##' 149 | ##' @title goplot 150 | ##' @rdname goplot 151 | ##' @param x enrichment result. 152 | ##' @param showCategory number of enriched terms to display 153 | ##' @param color variable that used to color enriched terms, e.g. pvalue, 154 | ##' p.adjust or qvalue 155 | ##' @param layout layout of the map 156 | ##' @param geom label geom, one of 'label' or 'text' 157 | ##' @param ... additional parameter 158 | ##' @return ggplot object 159 | ##' @export 160 | ##' @examples 161 | ##' \dontrun{ 162 | ##' library(clusterProfiler) 163 | ##' data(geneList, package = "DOSE") 164 | ##' de <- names(geneList)[1:100] 165 | ##' yy <- enrichGO(de, 'org.Hs.eg.db', ont="BP", pvalueCutoff=0.01) 166 | ##' goplot(yy) 167 | ##' goplot(yy, showCategory = 5) 168 | ##' } 169 | ##' @author Guangchuang Yu 170 | setGeneric("goplot", 171 | function(x, showCategory = 10, color = "p.adjust", 172 | layout = "sugiyama", geom = "text", ...) 173 | standardGeneric("goplot") 174 | ) 175 | 176 | ##' visualize analyzing result of GSEA 177 | ##' 178 | ##' plotting function for gseaResult 179 | ##' @title gseaplot 180 | ##' @rdname gseaplot 181 | ##' @param x object of gsea result 182 | ##' @param geneSetID geneSet ID 183 | ##' @param by one of "runningScore" or "position" 184 | ##' @param title plot title 185 | ##' @param ... additional parameters 186 | ##' @return ggplot2 object 187 | ##' @export 188 | ##' @examples 189 | ##' library(DOSE) 190 | ##' data(geneList) 191 | ##' x <- gseDO(geneList) 192 | ##' gseaplot(x, geneSetID=1) 193 | ##' @author Guangchuang Yu 194 | setGeneric("gseaplot", 195 | function(x, geneSetID, by = "all", title = "", ...) { 196 | standardGeneric("gseaplot") 197 | }) 198 | 199 | 200 | ##' heatmap like plot for functional classification 201 | ##' 202 | ##' 203 | ##' @title heatplot 204 | ##' @rdname heatplot 205 | ##' @param x enrichment result. 206 | ##' @param showCategory number of enriched terms to display 207 | ##' @param foldChange fold Change. 208 | ##' @param label_format a numeric value sets wrap length, alternatively a 209 | ##' custom function to format axis labels. 210 | ##' @param ... Additional parameters 211 | ##' @export 212 | ##' @return ggplot object 213 | ##' @examples 214 | ##' library(DOSE) 215 | ##' data(geneList) 216 | ##' de <- names(geneList)[1:100] 217 | ##' x <- enrichDO(de) 218 | ##' heatplot(x) 219 | ##' @author Guangchuang Yu 220 | setGeneric("heatplot", 221 | function(x, showCategory = 30, ...) 222 | standardGeneric("heatplot") 223 | ) 224 | 225 | ##' volcano plot for enrichment result 226 | ##' 227 | ##' 228 | ##' @title volplot 229 | ##' @rdname volplot 230 | ##' @param x enrichment result. 231 | ##' @param color selected variable to color the dots 232 | ##' @param xintercept value to set x intercept 233 | ##' @param yintercept value to set y intercept 234 | ##' @param showCategory number of most significant enriched terms or selected terms to 235 | ##' display determined by the variable selected to color the dots 236 | ##' @param label_format a numeric value sets wrap length, alternatively a 237 | ##' custom function to format axis labels. 238 | ##' @param ... Additional parameters 239 | ##' @export 240 | ##' @return ggplot object 241 | ##' @examples 242 | ##' library(DOSE) 243 | ##' data(geneList) 244 | ##' de <- names(geneList)[1:100] 245 | ##' x <- enrichDO(de) 246 | ##' volplot(x) 247 | ##' @author Guangchuang Yu 248 | setGeneric("volplot", 249 | function(x, color = "zScore", 250 | xintercept = 1, yintercept = 2, 251 | showCategory = 5, label_format = 30, 252 | ...) 253 | standardGeneric("volplot") 254 | ) 255 | 256 | ##' ridgeline plot for GSEA result 257 | ##' 258 | ##' 259 | ##' @title ridgeplot 260 | ##' @rdname ridgeplot 261 | ##' @param x gseaResult object 262 | ##' @param showCategory A number or a vector of terms. If it is a number, 263 | ##' the first n terms will be displayed. If it is a vector of terms, 264 | ##' the selected terms will be displayed. 265 | ##' @param fill one of "pvalue", "p.adjust", "qvalue" 266 | ##' @param core_enrichment whether only using core_enriched genes 267 | ##' @param label_format a numeric value sets wrap length, alternatively a 268 | ##' custom function to format axis labels. 269 | ##' @param ... additional parameters 270 | ##' by default wraps names longer that 30 characters 271 | ##' @return ggplot object 272 | ##' @export 273 | ##' @examples 274 | ##' library(DOSE) 275 | ##' data(geneList) 276 | ##' x <- gseDO(geneList) 277 | ##' ridgeplot(x) 278 | ##' @author Guangchuang Yu 279 | setGeneric("ridgeplot", 280 | function(x, showCategory=30, fill="p.adjust", core_enrichment = TRUE, 281 | label_format = 30, ...) 282 | standardGeneric("ridgeplot") 283 | ) 284 | 285 | 286 | ##' upsetplot method generics 287 | ##' 288 | ##' 289 | ##' @docType methods 290 | ##' @name upsetplot 291 | ##' @rdname upsetplot-methods 292 | ##' @title upsetplot method 293 | ##' @param x object 294 | ##' @param ... additional parameters 295 | ##' @return plot 296 | ##' @export 297 | ##' @author Guangchuang Yu 298 | setGeneric("upsetplot", function(x, ...) standardGeneric("upsetplot")) 299 | 300 | 301 | ##' Functional grouping tree diagram for enrichment result of 302 | ##' over-representation test or gene set enrichment analysis. 303 | ##' 304 | ##' 305 | ##' This function visualizes gene sets as a tree. 306 | ##' Gene sets with high similarity tend to cluster together, making it easier 307 | ##' for interpretation. 308 | ##' @title treeplot 309 | ##' @rdname treeplot 310 | ##' @param x enrichment result. 311 | ##' @param showCategory number of enriched terms to display 312 | ##' @param color variable that used to color enriched terms, e.g. pvalue, 313 | ##' p.adjust or qvalue 314 | ##' @param label_format a numeric value sets wrap length, alternatively a 315 | ##' custom function to format axis labels. 316 | ##' @param ... additional parameters 317 | ##' @return ggplot object 318 | ##' @export 319 | ##' @examples 320 | ##' \dontrun{ 321 | ##' library(clusterProfiler) 322 | ##' library(org.Hs.eg.db) 323 | ##' library(enrichplot) 324 | ##' library(GOSemSim) 325 | ##' library(ggplot2) 326 | ##' library(DOSE) 327 | ##' data(geneList) 328 | ##' gene <- names(geneList)[abs(geneList) > 2] 329 | ##' ego <- enrichGO(gene = gene, 330 | ##' universe = names(geneList), 331 | ##' OrgDb = org.Hs.eg.db, 332 | ##' ont = "BP", 333 | ##' pAdjustMethod = "BH", 334 | ##' pvalueCutoff = 0.01, 335 | ##' qvalueCutoff = 0.05, 336 | ##' readable = TRUE) 337 | ##' d <- godata('org.Hs.eg.db', ont="BP") 338 | ##' ego2 <- pairwise_termsim(ego, method = "Wang", semData = d) 339 | ##' treeplot(ego2, showCategory = 30) 340 | ##' # use `hilight = FALSE` to remove ggtree::geom_hilight() layer. 341 | ##' treeplot(ego2, showCategory = 30, hilight = FALSE) 342 | ##' # use `offset` parameter to adjust the distance of bar and tree. 343 | ##' treeplot(ego2, showCategory = 30, hilight = FALSE, offset = rel(1.5)) 344 | ##' # use `offset_tiplab` parameter to adjust the distance of nodes and branches. 345 | ##' treeplot(ego2, showCategory = 30, hilight = FALSE, offset_tiplab = rel(1.5)) 346 | ##' keep <- rownames(ego2@termsim)[c(1:10, 16:20)] 347 | ##' keep 348 | ##' treeplot(ego2, showCategory = keep) 349 | ##' treeplot(ego2, showCategory = 20, 350 | ##' group_color = c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442")) 351 | ##' # It can also graph compareClusterResult 352 | ##' data(gcSample) 353 | ##' xx <- compareCluster(gcSample, fun="enrichKEGG", 354 | ##' organism="hsa", pvalueCutoff=0.05) 355 | ##' xx <- pairwise_termsim(xx) 356 | ##' treeplot(xx) 357 | ##' 358 | ##' # use `geneClusterPanel` to change the gene cluster panel. 359 | ##' treeplot(xx, geneClusterPanel = "dotplot") 360 | ##' 361 | ##' treeplot(xx, geneClusterPanel = "pie") 362 | ##' } 363 | setGeneric("treeplot", 364 | function(x, ...) 365 | standardGeneric("treeplot") 366 | ) 367 | 368 | ##' Similarity space plot of enrichment analysis results. 369 | ##' 370 | ##' @title ssplot 371 | ##' @rdname ssplot 372 | ##' @inheritParams emapplot 373 | ##' @return ggplot object 374 | ##' @export 375 | ##' @examples 376 | ##' \dontrun{ 377 | ##' library(clusterProfiler) 378 | ##' library(org.Hs.eg.db) 379 | ##' library(enrichplot) 380 | ##' library(GOSemSim) 381 | ##' library(DOSE) 382 | ##' data(geneList) 383 | ##' gene <- names(geneList)[abs(geneList) > 2] 384 | ##' ego <- enrichGO(gene = gene, 385 | ##' universe = names(geneList), 386 | ##' OrgDb = org.Hs.eg.db, 387 | ##' ont = "BP", 388 | ##' pAdjustMethod = "BH", 389 | ##' pvalueCutoff = 0.01, 390 | ##' qvalueCutoff = 0.05, 391 | ##' readable = TRUE) 392 | ##' d <- godata('org.Hs.eg.db', ont="BP") 393 | ##' ego2 <- pairwise_termsim(ego, method = "Wang", semData = d) 394 | ##' ssplot(ego2) 395 | ##' } 396 | ##' @author Guangchuang Yu 397 | setGeneric("ssplot", 398 | function(x, ...) 399 | standardGeneric("ssplot") 400 | ) 401 | 402 | 403 | -------------------------------------------------------------------------------- /R/barplot.R: -------------------------------------------------------------------------------- 1 | 2 | ##' barplot of enrichResult 3 | ##' 4 | ##' 5 | ##' @importFrom graphics barplot 6 | ##' @importFrom ggplot2 %+% 7 | ##' @importFrom ggplot2 scale_fill_continuous 8 | ##' @importFrom ggplot2 aes 9 | ##' @importFrom ggplot2 geom_col 10 | ## @importFrom ggplot2 coord_flip 11 | ##' @importFrom ggplot2 theme 12 | ##' @importFrom ggplot2 ggtitle 13 | ##' @importFrom ggplot2 xlab 14 | ##' @importFrom ggplot2 ylab 15 | ##' @importFrom ggplot2 scale_y_discrete 16 | ##' @title barplot 17 | ##' @param height enrichResult object 18 | ##' @param x one of 'Count' and 'GeneRatio' 19 | ##' @param color one of 'pvalue', 'p.adjust' and 'qvalue' 20 | ##' @param showCategory number of categories to show 21 | ##' @param font.size font size 22 | ##' @param title plot title 23 | ##' @param label_format a numeric value sets wrap length, alternatively a 24 | ##' custom function to format axis labels. 25 | ##' by default wraps names longer that 30 characters 26 | ##' @param ... other parameter, ignored 27 | ##' @method barplot enrichResult 28 | ##' @export 29 | ##' @return ggplot object 30 | ##' @examples 31 | ##' library(DOSE) 32 | ##' data(geneList) 33 | ##' de <- names(geneList)[1:100] 34 | ##' x <- enrichDO(de) 35 | ##' barplot(x) 36 | ##' # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. 37 | ##' barplot(x, showCategory = 10) 38 | ##' categorys <- c("urinary bladder cancer", "bronchiolitis obliterans", 39 | ##' "aortic aneurysm", "esophageal cancer") 40 | ##' barplot(x, showCategory = categorys) 41 | barplot.enrichResult <- function(height, x="Count", color='p.adjust', 42 | showCategory=8, font.size=12, title="", 43 | label_format=30, ...) { 44 | ## use *height* to satisy barplot generic definition 45 | ## actually here is an enrichResult object. 46 | object <- height 47 | 48 | colorBy <- match.arg(color, c("pvalue", "p.adjust", "qvalue")) 49 | if (x == "geneRatio" || x == "GeneRatio") { 50 | x <- "GeneRatio" 51 | } 52 | else if (x == "count" || x == "Count") { 53 | x <- "Count" 54 | } 55 | 56 | df <- fortify(object, showCategory=showCategory, by=x, ...) 57 | 58 | if(colorBy %in% colnames(df)) { 59 | p <- ggplot(df, aes_string(x = x, y = "Description", fill = colorBy)) + 60 | theme_dose(font.size) + 61 | # scale_fill_continuous(name = color) + 62 | set_enrichplot_color(type = "fill", name = color) 63 | } else { 64 | p <- ggplot(df, aes_string(x = x, y = "Description", 65 | fill = "Description")) + 66 | theme_dose(font.size) + 67 | theme(legend.position="none") 68 | } 69 | 70 | label_func <- default_labeller(label_format) 71 | if(is.function(label_format)) { 72 | label_func <- label_format 73 | } 74 | 75 | p + geom_col() + # geom_bar(stat = "identity") + coord_flip() + 76 | scale_y_discrete(labels = label_func) + 77 | ggtitle(title) + ylab(NULL) # + xlab(NULL) 78 | } 79 | 80 | ##' @method barplot compareClusterResult 81 | ##' @export 82 | barplot.compareClusterResult <- function(height, color="p.adjust", 83 | showCategory=5, by="geneRatio", 84 | includeAll=TRUE, font.size=12, 85 | title="", ...) { 86 | ## use *height* to satisy barplot generic definition 87 | ## actually here is an compareClusterResult object. 88 | df <- fortify(height, showCategory=showCategory, by=by, 89 | includeAll=includeAll) 90 | plotting.clusterProfile(df, type="bar", colorBy=color, by=by, title=title, 91 | font.size=font.size) 92 | } 93 | -------------------------------------------------------------------------------- /R/cnetplot.R: -------------------------------------------------------------------------------- 1 | #' cnetplot 2 | #' 3 | #' category-gene-network plot 4 | #' @rdname cnetplot 5 | #' @param x input object 6 | #' @param layout network layout 7 | #' @param showCategory selected category to be displayed 8 | #' @param color_category color of category node 9 | #' @param size_category relative size of the category 10 | #' @param color_item color of item node 11 | #' @param size_item relative size of the item (e.g., genes) 12 | #' @param color_edge color of edge 13 | #' @param size_edge relative size of edge 14 | #' @param node_label one of 'all', 'none', 'category', 'item', 'exclusive' or 'share' 15 | #' @param foldChange numeric values to color the item (e.g, foldChange of gene expression values) 16 | #' @param hilight selected category to be highlighted 17 | #' @param hilight_alpha transparent value for not selected to be highlight 18 | #' @param ... additional parameters 19 | #' @importFrom ggtangle cnetplot 20 | #' @method cnetplot enrichResult 21 | #' @export 22 | #' @seealso 23 | #' [cnetplot][ggtangle::cnetplot] 24 | cnetplot.enrichResult <- function( 25 | x, layout = igraph::layout_with_kk, 26 | showCategory = 5, 27 | color_category= "#E5C494", size_category = 1, 28 | color_item = "#B3B3B3", size_item = 1, 29 | color_edge = "grey", size_edge=.5, 30 | node_label = "all", 31 | foldChange = NULL, 32 | hilight = "none", 33 | hilight_alpha = .3, 34 | ...) { 35 | 36 | geneSets <- extract_geneSets(x, showCategory) 37 | foldChange <- fc_readable(x, foldChange) 38 | 39 | p <- cnetplot(geneSets, 40 | layout = layout, 41 | showCategory = showCategory, 42 | foldChange = foldChange, 43 | color_category = color_category, 44 | size_category = size_category, 45 | color_item = color_item, 46 | size_item = size_item, 47 | color_edge = color_edge, 48 | size_edge = size_edge, 49 | node_label = node_label, 50 | hilight = hilight, 51 | hilight_alpha = hilight_alpha, 52 | ... 53 | ) 54 | 55 | p <- p + set_enrichplot_color(colors = get_enrichplot_color(3), name = "fold change") 56 | if (!is.null(foldChange)) { 57 | p <- p + guides(size = guide_legend(order = 1), 58 | color = guide_colorbar(order = 2)) 59 | } 60 | 61 | return(p + guides(alpha = "none")) 62 | } 63 | 64 | #' @rdname cnetplot 65 | #' @method cnetplot gseaResult 66 | #' @export 67 | cnetplot.gseaResult <- cnetplot.enrichResult 68 | 69 | #' @rdname cnetplot 70 | #' @param pie one of 'equal' or 'Count' to set the slice ratio of the pies 71 | #' @method cnetplot compareClusterResult 72 | #' @export 73 | cnetplot.compareClusterResult <- function( 74 | x, layout = igraph::layout_with_kk, 75 | showCategory = 5, 76 | color_category= "#E5C494", size_category = 1, 77 | color_item = "#B3B3B3", size_item = 1, 78 | color_edge = "grey", size_edge=.5, 79 | node_label = "all", 80 | foldChange = NULL, 81 | hilight = "none", 82 | hilight_alpha = .3, 83 | pie = "equal", 84 | ...) { 85 | 86 | d <- tidy_compareCluster(x, showCategory) 87 | y <- split(d$geneID, d$Description) 88 | gs <- lapply(y, function(item) unique(unlist(strsplit(item, split="/")))) 89 | 90 | if (node_label == "all") { 91 | node_label = "item" 92 | add_category_label <- TRUE 93 | } else if (node_label == "category") { 94 | node_label = "none" 95 | add_category_label <- TRUE 96 | } else { 97 | add_category_label <- FALSE 98 | } 99 | 100 | p <- cnetplot(gs, layout = layout, 101 | showCategory=length(gs), 102 | foldChange = foldChange, 103 | color_category = color_category, 104 | size_category=0, 105 | color_item = color_item, 106 | size_item = size_item, 107 | color_edge = color_edge, 108 | size_edge = size_edge, 109 | node_label = node_label, 110 | hilight = hilight, 111 | hilight_alpha = hilight_alpha, 112 | ...) 113 | 114 | p <- add_node_pie(p, d, pie, pie_scale=size_category) 115 | 116 | if (add_category_label) { 117 | p <- p + geom_cnet_label(node_label='category') 118 | } 119 | return(p) 120 | } 121 | 122 | #' @importFrom ggplot2 coord_fixed 123 | add_node_pie <- function(p, d, pie = "equal", pie_scale = 1) { 124 | dd <- d[,c('Cluster', 'Description', 'Count')] 125 | pathway_size <- sapply(split(dd$Count, dd$Description), sum) 126 | if (pie == "equal") dd$Count <- 1 127 | dd <- tidyr::pivot_wider(dd, names_from="Cluster", values_from="Count", values_fill=0) 128 | # dd$pathway_size <- sqrt(pathway_size[dd$Description]/sum(pathway_size)) 129 | dd$pathway_size <- pathway_size[dd$Description]/sum(pathway_size) 130 | 131 | p <- p %<+% dd + 132 | scatterpie::geom_scatterpie(aes(x=.data$x, y=.data$y, r=.data$pathway_size * pie_scale), 133 | cols=as.character(unique(d$Cluster)), 134 | legend_name = "Cluster", color=NA) + 135 | scatterpie::geom_scatterpie_legend( 136 | dd$pathway_size * pie_scale, x=min(p$data$x), y=min(p$data$y), n=3, 137 | # labeller=function(x) round(sum(pathway_size) * x^2) 138 | labeller=function(x) round(x * sum(pathway_size)) 139 | ) + 140 | coord_fixed() + 141 | guides(size = "none") 142 | 143 | return(p) 144 | } 145 | 146 | tidy_compareCluster <- function(x, showCategory) { 147 | d <- fortify(x, showCategory = showCategory, includeAll = TRUE, split = NULL) 148 | d$Cluster <- sub("\n.*", "", d$Cluster) 149 | 150 | if ("core_enrichment" %in% colnames(d)) { ## for GSEA result 151 | d$geneID <- d$core_enrichment 152 | } 153 | return(d) 154 | } 155 | -------------------------------------------------------------------------------- /R/densityplot.R: -------------------------------------------------------------------------------- 1 | ##' plot logFC distribution of selected gene sets 2 | ##' 3 | ##' 4 | ##' @title gseadist 5 | ##' @param x GSEA result 6 | ##' @param IDs gene set IDs 7 | ##' @param type one of 'density' or 'boxplot' 8 | ##' @return distribution plot 9 | ##' @importFrom ggplot2 geom_density 10 | ##' @importFrom ggplot2 geom_boxplot 11 | ##' @export 12 | ##' @author Guangchuang Yu 13 | gseadist <- function(x, IDs, type = 'density') { 14 | d <- data.frame(gene = names(x@geneList), 15 | logFC = x@geneList, 16 | category = 'All Genes') 17 | 18 | ds <- do.call('rbind', lapply(IDs, function(i) { 19 | if (!is.numeric(i)) { 20 | i <- match(i, x$ID) 21 | if (is.na(i)) 22 | i <- match(i, x$Description) 23 | } 24 | id <- x$ID[i] 25 | 26 | gene <- x@geneSets[[id]] 27 | gs <- x@geneList[gene] 28 | gs <- gs[!is.na(gs)] 29 | data.frame(gene = names(gs), 30 | logFC = gs, 31 | category = x$Description[i]) 32 | })) 33 | dd <- rbind(d, ds) 34 | 35 | p <- ggplot(dd) + theme_minimal() 36 | 37 | if (type == 'density') { 38 | p <- p + 39 | geom_density(aes_(x = ~logFC, color = ~category)) + 40 | ## geom_rug(data = ds, show.legend = FALSE) + 41 | ylab(NULL) + 42 | theme(legend.title = element_blank(), 43 | legend.position = 'bottom') 44 | } else if (type == 'boxplot') { 45 | p <- p + 46 | geom_boxplot(aes_(x = ~category, y = ~logFC, fill = ~category)) + 47 | xlab(NULL) + 48 | theme(legend.position = 'none') 49 | } 50 | return(p) 51 | } 52 | -------------------------------------------------------------------------------- /R/emapplot.R: -------------------------------------------------------------------------------- 1 | ##' @rdname emapplot 2 | ##' @exportMethod emapplot 3 | setMethod("emapplot", signature(x = "enrichResult"), 4 | function(x, showCategory = 30, ...) { 5 | emapplot_internal(x, showCategory = showCategory, ...) 6 | }) 7 | 8 | ##' @rdname emapplot 9 | ##' @exportMethod emapplot 10 | setMethod("emapplot", signature(x = "gseaResult"), 11 | function(x, showCategory = 30, ...) { 12 | emapplot_internal(x, showCategory = showCategory, ...) 13 | }) 14 | 15 | ##' @rdname emapplot 16 | ##' @exportMethod emapplot 17 | setMethod("emapplot", signature(x = "compareClusterResult"), 18 | function(x, showCategory = 30, ...) { 19 | 20 | emapplot_internal(x, showCategory = showCategory, ...) 21 | }) 22 | 23 | 24 | 25 | 26 | ##' @rdname emapplot 27 | #' @param layout igraph layout 28 | #' @param color Variable that used to color enriched terms, e.g. 'pvalue', 29 | #' 'p.adjust' or 'qvalue'. 30 | #' @param size_category relative size of the categories 31 | #' @param min_edge The minimum similarity threshold for whether 32 | #' two nodes are connected, should between 0 and 1, default value is 0.2. 33 | #' @param color_edge color of the network edge 34 | #' @param size_edge relative size of edge width 35 | #' @param node_label Select which labels to be displayed, 36 | #' one of 'category', 'group', 'all' and 'none'. 37 | #' @param pie one of 'equal' or 'Count' to set the slice ratio of the pies 38 | #' @param group logical, if TRUE, group the category. 39 | #' @param group_style style of ellipse, one of "ggforce" an "polygon". 40 | #' @param label_group_style style of group label, one of "shadowtext" and "ggforce". 41 | #' @param label_format a numeric value sets wrap length, alternatively a custom function to format axis labels. 42 | #' @param clusterFunction function of Clustering method, such as stats::kmeans(the default), 43 | #' cluster::clara, cluster::fanny or cluster::pam. 44 | #' @param nWords Numeric, the number of words in the cluster tags, the default value is 4. 45 | #' @param nCluster Numeric, the number of clusters, 46 | #' the default value is square root of the number of nodes. 47 | #' @importFrom ggplot2 scale_size 48 | #' @importFrom ggtangle geom_edge 49 | #' @importFrom ggrepel geom_text_repel 50 | #' @importFrom ggrepel geom_label_repel 51 | #' @importFrom DOSE geneInCategory 52 | #' @author Guangchuang Yu 53 | emapplot_internal <- function( 54 | x, layout=igraph::layout_with_kk, 55 | showCategory = 30, color = "p.adjust", 56 | size_category =1, 57 | min_edge =.2, 58 | color_edge = "grey", size_edge=.5, 59 | node_label = "category", 60 | pie = "equal", 61 | group = FALSE, 62 | group_style = "ggforce", 63 | label_group_style = "shawdowtext", 64 | label_format = 30, 65 | clusterFunction = stats::kmeans, 66 | nWords = 4, 67 | nCluster = NULL 68 | ) { 69 | 70 | if (inherits(x, 'compareClusterResult')) { 71 | gg <- graph_from_compareClusterResult( 72 | x, showCategory = showCategory, color = color, 73 | min_edge = min_edge, size_edge = size_edge 74 | ) 75 | } else { 76 | gg <- graph_from_enrichResult( 77 | x, showCategory = showCategory, color = color, 78 | min_edge = min_edge, size_edge = size_edge 79 | ) 80 | } 81 | 82 | g <- gg$graph 83 | size <- vapply(gg$geneSet, length, FUN.VALUE= numeric(1)) 84 | V(g)$size = size[V(g)$name] 85 | 86 | p <- ggplot(g, layout = layout) + geom_edge(color = color_edge, size = size_edge) 87 | 88 | if (inherits(x, 'compareClusterResult')) { 89 | p <- add_node_pie(p, gg$data, pie, pie_scale=size_category) 90 | } else { 91 | if (color %in% names(as.data.frame(x))) { 92 | p <- p %<+% x[, c("Description", color)] + 93 | geom_point(aes(color=.data[[color]], size=.data$size)) + 94 | scale_size(range=c(3, 8) * size_category) 95 | p <- p + set_enrichplot_color(colors = get_enrichplot_color(2)) 96 | p <- p + guides(size = guide_legend(order = 1), 97 | color = guide_colorbar(order = 2, reverse = TRUE)) 98 | } else { 99 | p <- p %<+% x[, "Description", drop=FALSE] + 100 | geom_point(aes(size=.data$size), color=color) + 101 | scale_size(range=c(3, 8) * size_category) 102 | } 103 | } 104 | 105 | if (group) { 106 | if (inherits(x, 'compareClusterResult')) { 107 | p <- p + ggnewscale::new_scale_fill() 108 | } #else { 109 | # p <- p + ggnewscale::new_scale_color() 110 | #} 111 | ggData <- groupNode(p, as.data.frame(x), nWords, clusterFunction = clusterFunction, nCluster=nCluster) 112 | p$data <- ggData 113 | p <- add_ellipse(p, group_legend = TRUE, label_style = label_group_style, ellipse_style = group_style) 114 | } 115 | 116 | ## add node label 117 | if (node_label == "all" || node_label == "category") 118 | p <- p + geom_text_repel(aes(label=.data$label), bg.color="white", bg.r=.1) 119 | ## add group label 120 | if (node_label == "all" || node_label == "group") { 121 | label_location <- get_label_location(ggData = ggData, label_format = label_format) 122 | p <- p + geom_text_repel(aes(x=.data$x, y = .data$y, label=.data$label), data = label_location, bg.color="white", bg.r=.1) 123 | } 124 | 125 | p + coord_equal() + 126 | guides(size = guide_legend(order = 1), 127 | color = guide_colorbar(order = 2)) 128 | } 129 | 130 | graph_from_enrichResult <- function( 131 | x, 132 | showCategory = 30, color = "p.adjust", 133 | min_edge =.2, size_edge=.5 134 | ) { 135 | n <- update_n(x, showCategory) 136 | y <- as.data.frame(x) 137 | ## get graph.data.frame() object 138 | g <- get_igraph(x=x, nCategory=n, color=color, cex_line = size_edge, 139 | min_edge=min_edge) 140 | gs <- extract_geneSets(x, n) 141 | return(list(graph = g, geneSet = gs)) 142 | } 143 | 144 | graph_from_compareClusterResult <- function( 145 | x, 146 | showCategory = 30, color = "p.adjust", 147 | min_edge =.2, size_edge=.5 148 | ) { 149 | 150 | d <- tidy_compareCluster(x, showCategory) 151 | mergedEnrichDf <- merge_compareClusterResult(d) 152 | gs <- setNames(strsplit(as.character(mergedEnrichDf$geneID), "/", 153 | fixed = TRUE), mergedEnrichDf$ID) 154 | 155 | g <- build_emap_graph(enrichDf=mergedEnrichDf,geneSets=gs,color=color, 156 | cex_line=size_edge, min_edge=min_edge, 157 | pair_sim = x@termsim, method = x@method) 158 | return(list(graph = g, geneSet = gs, data = d)) 159 | } 160 | 161 | 162 | 163 | -------------------------------------------------------------------------------- /R/emapplot_utilities.R: -------------------------------------------------------------------------------- 1 | ##' Get the similarity matrix 2 | ##' 3 | ##' @param y A data.frame of enrichment result 4 | ##' @param geneSets A list, the names of geneSets are term ids, 5 | ##' and every object is a vertor of genes. 6 | ##' @param method Method of calculating the similarity between nodes, 7 | ##' one of "Resnik", "Lin", "Rel", "Jiang" , "Wang" and 8 | ##' "JC" (Jaccard similarity coefficient) methods 9 | ##' @param semData GOSemSimDATA object 10 | ##' @noRd 11 | get_similarity_matrix <- function(y, geneSets, method, semData = NULL) { 12 | id <- y[, "ID"] 13 | geneSets <- geneSets[id] 14 | y_id <- unlist(strsplit(y$ID[1], ":"))[1] 15 | ## Choose the method to calculate the similarity 16 | if (method == "JC") { 17 | w <- .cal_jc_similarity(geneSets, id = id, name = y$Description) 18 | return(w) 19 | } 20 | 21 | if (y_id == "GO") { 22 | if(is.null(semData)) { 23 | stop("The semData parameter is missing, 24 | and it can be obtained through godata function in GOSemSim package.") 25 | } 26 | w <- GOSemSim::mgoSim(id, id, semData=semData, measure=method, 27 | combine=NULL) 28 | } 29 | 30 | if (y_id == "DOID") w <- DOSE::doSim(id, id, measure=method) 31 | rownames(y) <- y$ID 32 | rownames(w) <- colnames(w) <- y[colnames(w), "Description"] 33 | return(w) 34 | } 35 | 36 | 37 | ##' Check whether the similarity matrix exists 38 | ##' 39 | ##' @param x result of enrichment analysis 40 | ##' 41 | ##' @noRd 42 | has_pairsim <- function(x) { 43 | if (length(x@termsim) == 0) { 44 | error_message <- paste("Term similarity matrix not available.", 45 | "Please use pairwise_termsim function to", 46 | "deal with the results of enrichment analysis.") 47 | stop(error_message) 48 | } 49 | 50 | } 51 | 52 | 53 | #' Get graph_from_data_frame() result 54 | #' 55 | #' @importFrom igraph graph.empty 56 | #' @importFrom igraph graph_from_data_frame 57 | #' @param enrichDf A data.frame of enrichment result. 58 | #' @param geneSets A list gene sets with the names of enrichment IDs 59 | #' @param color a string, the column name of y for nodes colours 60 | #' @param cex_line Numeric, scale of line width 61 | #' @param min_edge The minimum similarity threshold for whether 62 | #' two nodes are connected, should between 0 and 1, default value is 0.2. 63 | #' @param pair_sim Semantic similarity matrix. 64 | #' @param method Method of calculating the similarity between nodes, 65 | #' one of "Resnik", "Lin", "Rel", "Jiang" , "Wang" and 66 | #' "JC" (Jaccard similarity coefficient) methods 67 | #' @return result of graph_from_data_frame() 68 | #' @importFrom igraph V 69 | #' @importFrom igraph 'V<-' 70 | #' @importFrom igraph E 71 | #' @importFrom igraph 'E<-' 72 | #' @importFrom igraph add_vertices 73 | #' @importFrom igraph delete.edges 74 | #' @noRd 75 | build_emap_graph <- function(enrichDf, geneSets, color, cex_line, min_edge, 76 | pair_sim, method) { 77 | 78 | if (!is.numeric(min_edge) | min_edge < 0 | min_edge > 1) { 79 | stop('"min_edge" should be a number between 0 and 1.') 80 | } 81 | 82 | if (is.null(dim(enrichDf)) | nrow(enrichDf) == 1) { # when just one node 83 | g <- graph.empty(0, directed=FALSE) 84 | g <- add_vertices(g, nv = 1) 85 | V(g)$name <- as.character(enrichDf$Description) 86 | V(g)$color <- "red" 87 | return(g) 88 | } else { 89 | w <- pair_sim[as.character(enrichDf$Description), 90 | as.character(enrichDf$Description)] 91 | } 92 | 93 | wd <- reshape2::melt(w) 94 | wd <- wd[wd[,1] != wd[,2],] 95 | # remove NA 96 | wd <- wd[!is.na(wd[,3]),] 97 | if (method != "JC") { 98 | # map id to names 99 | wd[, 1] <- enrichDf[wd[, 1], "Description"] 100 | wd[, 2] <- enrichDf[wd[, 2], "Description"] 101 | } 102 | 103 | g <- graph_from_data_frame(wd[, -3], directed=FALSE) 104 | E(g)$width <- sqrt(wd[, 3] * 5) * cex_line 105 | # Use similarity as the weight(length) of an edge 106 | E(g)$weight <- wd[, 3] 107 | g <- delete.edges(g, E(g)[wd[, 3] < min_edge]) 108 | idx <- unlist(sapply(V(g)$name, function(x) which(x == enrichDf$Description))) 109 | cnt <- sapply(geneSets[idx], length) 110 | V(g)$size <- cnt 111 | if (color %in% names(enrichDf)) { 112 | colVar <- enrichDf[idx, color] 113 | } else { 114 | colVar <- color 115 | } 116 | 117 | V(g)$color <- colVar 118 | return(g) 119 | } 120 | 121 | 122 | 123 | ##' Get an iGraph object 124 | ##' 125 | ##' @param x Enrichment result. 126 | ##' @param nCategory Number of enriched terms to display. 127 | ##' @param color variable that used to color enriched terms, e.g. 'pvalue', 128 | ##' 'p.adjust' or 'qvalue'. 129 | ##' @param cex_line Scale of line width. 130 | ##' @param min_edge The minimum similarity threshold for whether 131 | ##' two nodes are connected, should between 0 and 1, default value is 0.2. 132 | ##' 133 | ##' @return an iGraph object 134 | ##' @noRd 135 | get_igraph <- function(x, nCategory, color, cex_line, min_edge){ 136 | y <- as.data.frame(x) 137 | geneSets <- geneInCategory(x) ## use core gene for gsea result 138 | if (is.numeric(nCategory)) { 139 | y <- y[1:nCategory, ] 140 | } else { 141 | y <- y[match(nCategory, y$Description),] 142 | nCategory <- length(nCategory) 143 | } 144 | 145 | if (nCategory == 0) { 146 | stop("no enriched term found...") 147 | } 148 | 149 | build_emap_graph(enrichDf = y, geneSets = geneSets, color = color, 150 | cex_line = cex_line, min_edge = min_edge, 151 | pair_sim = x@termsim, method = x@method) 152 | } 153 | 154 | 155 | ##' Merge the compareClusterResult file 156 | ##' 157 | ##' @param yy A data.frame of enrichment result. 158 | ##' 159 | ##' @return a data.frame 160 | ##' @noRd 161 | merge_compareClusterResult <- function(yy) { 162 | yy_union <- yy[!duplicated(yy$ID),] 163 | yy_ids <- lapply(split(yy, yy$ID), function(x) { 164 | ids <- unique(unlist(strsplit(x$geneID, "/"))) 165 | cnt <- length(ids) 166 | list(ID=paste0(ids, collapse="/"), cnt=cnt) 167 | }) 168 | 169 | ids <- vapply(yy_ids, function(x) x$ID, character(1)) 170 | cnt <- vapply(yy_ids, function(x) x$cnt, numeric(1)) 171 | 172 | yy_union$geneID <- ids[yy_union$ID] 173 | yy_union$Count <- cnt[yy_union$ID] 174 | yy_union$Cluster <- NULL 175 | yy_union 176 | } 177 | 178 | ##' add alpha attribute to ggraph edges 179 | ##' 180 | ##' @param g ggraph object. 181 | ##' @param hilight_category category nodes to be highlight. 182 | ##' @param alpha_hilight alpha of highlighted nodes. 183 | ##' @param alpha_nohilight alpha of unhighlighted nodes. 184 | ##' @noRd 185 | edge_add_alpha <- function(g, hilight_category, alpha_nohilight, alpha_hilight) { 186 | if (!is.null(hilight_category) && length(hilight_category) > 0) { 187 | edges <- attr(E(g), "vnames") 188 | E(g)$alpha <- rep(alpha_nohilight, length(E(g))) 189 | hilight_edge <- grep(paste(hilight_category, collapse = "|"), edges) 190 | E(g)$alpha[hilight_edge] <- min(0.8, alpha_hilight) 191 | # E(g)$alpha[hilight_edge] <- alpha_hilight 192 | } else { 193 | E(g)$alpha <- rep(min(0.8, alpha_hilight), length(E(g))) 194 | } 195 | return(g) 196 | } 197 | 198 | ##' add alpha attribute to ggraph nodes 199 | ##' 200 | ##' @param p ggraph object. 201 | ##' @param hilight_category category nodes to be highlight. 202 | ##' @param hilight_gene gene nodes to be highlight. 203 | ##' @param alpha_hilight alpha of highlighted nodes. 204 | ##' @param alpha_nohilight alpha of unhighlighted nodes. 205 | ##' @noRd 206 | node_add_alpha <- function(p, hilight_category, hilight_gene, alpha_nohilight, alpha_hilight) { 207 | alpha_node <- rep(1, nrow(p$data)) 208 | if (!is.null(hilight_category)) { 209 | alpha_node <- rep(alpha_nohilight, nrow(p$data)) 210 | hilight_node <- c(hilight_category, hilight_gene) 211 | alpha_node[match(hilight_node, p$data$name)] <- alpha_hilight 212 | } 213 | p$data$alpha <- alpha_node 214 | return(p) 215 | } 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | ##' Get the location of group label 224 | ##' 225 | ##' @param ggData data of a ggraph object 226 | ##' @param label_format A numeric value sets wrap length, alternatively a 227 | ##' custom function to format axis labels. 228 | ##' @return a data.frame object. 229 | ##' @noRd 230 | get_label_location <- function(ggData, label_format) { 231 | label_func <- default_labeller(label_format) 232 | if (is.function(label_format)) { 233 | label_func <- label_format 234 | } 235 | label_x <- stats::aggregate(x ~ color2, ggData, mean) 236 | label_y <- stats::aggregate(y ~ color2, ggData, mean) 237 | data.frame(x = label_x$x, y = label_y$y, 238 | label = label_func(label_x$color2)) 239 | } 240 | 241 | 242 | 243 | ##' Cluster similar nodes together by k-means 244 | ##' 245 | ##' @param p a ggraph object. 246 | ##' @param enrichDf data.frame of enrichment result. 247 | ##' @param nWords Numeric, the number of words in the cluster tags. 248 | ##' @param clusterFunction function of Clustering method, such as stats::kmeans, cluster::clara, 249 | ##' cluster::fanny or cluster::pam. 250 | ##' @param nCluster Numeric, the number of clusters, 251 | ##' the default value is square root of the number of nodes. 252 | ##' @noRd 253 | groupNode <- function(p, enrichDf, nWords, clusterFunction = stats::kmeans, nCluster) { 254 | ggData <- p$data 255 | wrongMessage <- paste("Wrong clusterFunction parameter or unsupported clustering method;", 256 | "set to default `clusterFunction = kmeans`") 257 | if (is.character(clusterFunction)) { 258 | clusterFunction <- eval(parse(text=clusterFunction)) 259 | } 260 | if (!"color2" %in% colnames(ggData)) { 261 | dat <- data.frame(x = ggData$x, y = ggData$y) 262 | nCluster <- ifelse(is.null(nCluster), floor(sqrt(nrow(dat))), 263 | min(nCluster, nrow(dat))) 264 | ggData$color2 <- tryCatch(expr = clusterFunction(dat, nCluster)$cluster, 265 | error = function(e) { 266 | message(wrongMessage) 267 | stats::kmeans(dat, nCluster)$cluster 268 | }) 269 | if (is.null(ggData$color2)) { 270 | message(wrongMessage) 271 | ggData$color2 <- stats::kmeans(dat, nCluster)$cluster 272 | } 273 | } 274 | goid <- enrichDf$ID 275 | cluster_color <- unique(ggData$color2) 276 | clusters <- lapply(cluster_color, function(i){goid[which(ggData$color2 == i)]}) 277 | cluster_label <- sapply(cluster_color, get_wordcloud, ggData = ggData, 278 | nWords=nWords) 279 | names(cluster_label) <- cluster_color 280 | ggData$color2 <- cluster_label[as.character(ggData$color2)] 281 | return(ggData) 282 | } 283 | 284 | #' add ellipse to group the node 285 | #' 286 | #' @param p ggplot2 object 287 | #' @param group_legend Logical, if TRUE, the grouping legend will be displayed. 288 | #' The default is FALSE. 289 | #' @param label_style style of group label, one of "shadowtext" and "ggforce". 290 | #' @param ellipse_style style of ellipse, one of "ggforce" an "polygon". 291 | #' @param ellipse_pro numeric indicating confidence value for the ellipses 292 | #' @param alpha the transparency of ellipse fill. 293 | #' @importFrom rlang check_installed 294 | #' @importFrom ggplot2 scale_fill_discrete 295 | #' @noRd 296 | add_ellipse <- function(p, group_legend, label_style, 297 | ellipse_style = "ggforce", ellipse_pro = 0.95, alpha = 0.3, ...) { 298 | show_legend <- c(group_legend, FALSE) 299 | names(show_legend) <- c("fill", "color") 300 | ellipse_style <- match.arg(ellipse_style, c("ggforce", "polygon")) 301 | 302 | check_installed('ggforce', 'for `add_ellipse()`.') 303 | 304 | if (ellipse_style == "ggforce") { 305 | if (label_style == "shadowtext") { 306 | p <- p + ggforce::geom_mark_ellipse( 307 | aes(x = .data$x, y = .data$y, fill = .data$color2), 308 | alpha = alpha, color = NA, show.legend = show_legend) 309 | } else { 310 | p <- p + ggforce::geom_mark_ellipse( 311 | aes(x = .data$x, y = .data$y, fill = .data$color2, label = .data$color2), 312 | alpha = alpha, color = NA, show.legend = show_legend) 313 | } 314 | if (group_legend) p <- p + scale_fill_discrete(name = "groups") 315 | } 316 | 317 | if (ellipse_style == "polygon") { 318 | p <- p + ggplot2::stat_ellipse(aes_(x =~ x, y =~ y, fill =~ color2), 319 | geom = "polygon", level = ellipse_pro, 320 | alpha = alpha, 321 | show.legend = group_legend, ...) 322 | } 323 | 324 | return(p) 325 | } 326 | 327 | 328 | 329 | list2df <- ggtangle:::list2df 330 | -------------------------------------------------------------------------------- /R/enrichplot-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | -------------------------------------------------------------------------------- /R/ggtable.R: -------------------------------------------------------------------------------- 1 | ##' plot table 2 | ##' 3 | ##' 4 | ##' @title ggtable 5 | ##' @param d data frame 6 | ##' @param p ggplot object to extract color to color rownames(d), optional 7 | ##' @importFrom rlang check_installed 8 | ##' @return ggplot object 9 | ##' @export 10 | ##' @author guangchuang yu 11 | ggtable <- function(d, p = NULL) { 12 | # has_package("ggplotify") 13 | check_installed('ggplotify', 'for `ggtable()`.') 14 | ggplotify::as.ggplot(tableGrob2(d, p)) 15 | } 16 | 17 | ##' @importFrom grid gpar 18 | ##' @importFrom ggplot2 ggplot_build 19 | ##' @importFrom rlang check_installed 20 | tableGrob2 <- function(d, p = NULL) { 21 | # has_package("gridExtra") 22 | d <- d[order(rownames(d)),] 23 | check_installed('gridExtra', 'for `tableGrob2()`.') 24 | tp <- gridExtra::tableGrob(d) 25 | if (is.null(p)) { 26 | return(tp) 27 | } 28 | 29 | # Fix bug: The 'group' order of lines and dots/path is different 30 | p_data <- ggplot_build(p)$data[[1]] 31 | # pcol <- unique(ggplot_build(p)$data[[1]][["colour"]]) 32 | p_data <- p_data[order(p_data[["group"]]), ] 33 | pcol <- unique(p_data[["colour"]]) 34 | ## This is fine too 35 | ## pcol <- unique(p_data[["colour"]])[unique(p_data[["group"]])] 36 | j <- which(tp$layout$name == "rowhead-fg") 37 | 38 | for (i in seq_along(pcol)) { 39 | tp$grobs[j][[i+1]][["gp"]] <- gpar(col = pcol[i]) 40 | } 41 | return(tp) 42 | } 43 | 44 | -------------------------------------------------------------------------------- /R/goplot.R: -------------------------------------------------------------------------------- 1 | ##' @rdname goplot 2 | ##' @exportMethod goplot 3 | setMethod("goplot", signature(x = "enrichResult"), 4 | function(x, showCategory = 10, color = "p.adjust", 5 | layout = igraph::layout_with_sugiyama, geom="text", ...) { 6 | goplot.enrichResult(x, showCategory = showCategory, 7 | color = color, layout = layout, geom = geom, ...) 8 | }) 9 | 10 | ##' @rdname goplot 11 | ##' @exportMethod goplot 12 | setMethod("goplot", signature(x = "gseaResult"), 13 | function(x, showCategory = 10, color = "p.adjust", 14 | layout = igraph::layout_with_sugiyama, geom="text", ...) { 15 | goplot.enrichResult(x, showCategory = showCategory, 16 | color = color, layout = layout, geom = geom, ...) 17 | }) 18 | 19 | 20 | 21 | ##' @importFrom utils data 22 | ##' @import GOSemSim 23 | ##' @importFrom ggplot2 scale_fill_gradientn 24 | ##' @importFrom grid arrow 25 | ##' @importFrom grid unit 26 | ##' @importFrom rlang check_installed 27 | goplot.enrichResult <- function(x, showCategory = 10, color = "p.adjust", 28 | layout = igraph::layout_with_sugiyama, geom = "text", 29 | ID = "Description", ...) { 30 | segment.size <- get_ggrepel_segsize() 31 | # has_package("AnnotationDbi") 32 | n <- update_n(x, showCategory) 33 | geneSets <- geneInCategory(x) ## use core gene for gsea result 34 | y <- as.data.frame(x) 35 | y <- y[1:n,] 36 | 37 | id <- y$ID[1:n] 38 | 39 | if (!exists(".GOSemSimEnv")) GOSemSim_initial() 40 | .GOSemSimEnv <- get(".GOSemSimEnv", envir=.GlobalEnv) 41 | gotbl <- get("gotbl", envir=.GOSemSimEnv) 42 | 43 | if (inherits(x, "gseaResult")) { 44 | onto <- x@setType 45 | } else { 46 | onto <- x@ontology 47 | } 48 | 49 | if (!toupper(onto) %in% c("MF", "CC", "BF")) { 50 | stop("Ontology should be one of 'MF', 'CC' or 'BP'") 51 | } 52 | 53 | GOANCESTOR <- getAncestors(onto) 54 | 55 | anc <- GOANCESTOR[id] 56 | ca <- anc[[1]] 57 | for (i in 2:length(anc)) { 58 | ca <- intersect(ca, anc[[i]]) 59 | } 60 | 61 | uanc <- unique(unlist(anc)) 62 | uanc <- uanc[!uanc %in% ca] 63 | dag <- gotbl[gotbl$go_id %in% unique(c(id, uanc)),] 64 | 65 | 66 | edge <- dag[, c(5, 1, 4)] 67 | node <- unique(gotbl[gotbl$go_id %in% unique(c(edge[,1], edge[,2])), 1:3]) 68 | node$color <- x[node$go_id, color] 69 | node$size <- sapply(geneSets[node$go_id], length) 70 | 71 | g <- graph_from_data_frame(edge, directed=TRUE, vertices=node) 72 | E(g)$relationship <- edge[,3] 73 | 74 | check_installed('ggarchery', 'for `goplot()`.') 75 | 76 | position = ggarchery::position_attractsegment( 77 | start_shave=.03, 78 | end_shave=.03, 79 | type_shave="proportion" 80 | ) 81 | p <- ggplot(g, layout = layout) + 82 | geom_edge(aes(linetype = .data$relationship), 83 | arrow = arrow(length = unit(2, 'mm')), 84 | colour="darkgrey", position=position) 85 | 86 | if (ID == "Description" || ID == "ID") { 87 | ID <- sprintf("{%s}", ID) 88 | } 89 | 90 | if (geom == "label") { 91 | p <- p + geom_label_repel(aes(label= glue::glue(ID, ID=.data[['name']], Description=.data[['Term']]), 92 | fill=.data$color, segment.size = segment.size)) + 93 | set_enrichplot_color(type = "fill", name = color, na.value="white") 94 | } else { 95 | p <- p + geom_point(aes(color=.data$color), size=5) + 96 | geom_text_repel(aes(label=glue::glue(ID, ID=.data[['name']], Description=.data[['Term']])), 97 | segment.size = segment.size, bg.color="white", bg.r=.1) + 98 | set_enrichplot_color(type = "color", name = color, na.value="grey") 99 | } 100 | 101 | return(p) 102 | } 103 | 104 | ##' @importFrom utils getFromNamespace 105 | GOSemSim_initial <- getFromNamespace(".initial", "GOSemSim") 106 | getAncestors <- getFromNamespace("getAncestors", "GOSemSim") 107 | -------------------------------------------------------------------------------- /R/gseaplot.R: -------------------------------------------------------------------------------- 1 | ##' @rdname gseaplot 2 | ##' @exportMethod gseaplot 3 | setMethod("gseaplot", signature(x = "gseaResult"), 4 | function (x, geneSetID, by = "all", title = "", color='black', 5 | color.line="green", color.vline="#FA5860", ...){ 6 | gseaplot.gseaResult(x, geneSetID = geneSetID, 7 | by = by, title = title, 8 | color = color, color.line = color.line, 9 | color.vline = color.vline, ...) 10 | }) 11 | 12 | ##' @rdname gseaplot 13 | ##' @param color color of line segments 14 | ##' @param color.line color of running enrichment score line 15 | ##' @param color.vline color of vertical line which indicating the 16 | ##' maximum/minimal running enrichment score 17 | ##' @return ggplot2 object 18 | ##' @importFrom ggplot2 ggplot 19 | ##' @importFrom ggplot2 geom_linerange 20 | ##' @importFrom ggplot2 geom_line 21 | ##' @importFrom ggplot2 geom_vline 22 | ##' @importFrom ggplot2 geom_hline 23 | ##' @importFrom ggplot2 xlab 24 | ##' @importFrom ggplot2 ylab 25 | ##' @importFrom ggplot2 xlim 26 | ##' @importFrom ggplot2 aes 27 | ##' @importFrom ggplot2 ggplotGrob 28 | ##' @importFrom ggplot2 geom_segment 29 | ##' @importFrom ggplot2 ggplot_gtable 30 | ##' @importFrom ggplot2 ggplot_build 31 | ##' @importFrom ggplot2 ggtitle 32 | ##' @importFrom ggplot2 element_text 33 | ##' @importFrom ggplot2 rel 34 | ##' @importFrom aplot plot_list 35 | ##' @author Guangchuang Yu 36 | gseaplot.gseaResult <- function (x, geneSetID, by = "all", title = "", 37 | color='black', color.line="green", 38 | color.vline="#FA5860", ...){ 39 | by <- match.arg(by, c("runningScore", "preranked", "all")) 40 | gsdata <- gsInfo(x, geneSetID) 41 | p <- ggplot(gsdata, aes_(x = ~x)) + 42 | theme_dose() + xlab("Position in the Ranked List of Genes") 43 | if (by == "runningScore" || by == "all") { 44 | p.res <- p + geom_linerange(aes_(ymin=~ymin, ymax=~ymax), color=color) 45 | p.res <- p.res + geom_line(aes_(y = ~runningScore), color=color.line, 46 | size=1) 47 | enrichmentScore <- x@result[geneSetID, "enrichmentScore"] 48 | es.df <- data.frame(es = which.min(abs(p$data$runningScore - enrichmentScore))) 49 | p.res <- p.res + geom_vline(data = es.df, aes_(xintercept = ~es), 50 | colour = color.vline, linetype = "dashed") 51 | p.res <- p.res + ylab("Running Enrichment Score") 52 | p.res <- p.res + geom_hline(yintercept = 0) 53 | } 54 | if (by == "preranked" || by == "all") { 55 | df2 <- data.frame(x = which(p$data$position == 1)) 56 | df2$y <- p$data$geneList[df2$x] 57 | p.pos <- p + geom_segment(data=df2, aes_(x=~x, xend=~x, y=~y, yend=0), 58 | color=color) 59 | p.pos <- p.pos + ylab("Ranked List Metric") + 60 | xlim(0, length(p$data$geneList)) 61 | } 62 | if (by == "runningScore") 63 | return(p.res + ggtitle(title)) 64 | if (by == "preranked") 65 | return(p.pos + ggtitle(title)) 66 | 67 | p.pos <- p.pos + xlab(NULL) + theme(axis.text.x = element_blank(), 68 | axis.ticks.x = element_blank()) 69 | p.pos <- p.pos + ggtitle(title) + 70 | theme(plot.title=element_text(hjust=0.5, size=rel(2))) 71 | #plot_list(gglist = list(p.pos, p.res), ncol=1) 72 | 73 | aplot::gglist(gglist = list(p.pos, p.res), ncol=1) 74 | } 75 | 76 | 77 | ##' extract gsea result of selected geneSet 78 | ##' 79 | ##' 80 | ##' @title gsInfo 81 | ##' @param object gseaResult object 82 | ##' @param geneSetID gene set ID 83 | ##' @return data.frame 84 | ##' @author Guangchuang Yu 85 | ## @export 86 | gsInfo <- function(object, geneSetID) { 87 | geneList <- object@geneList 88 | 89 | if (is.numeric(geneSetID)) 90 | geneSetID <- object@result[geneSetID, "ID"] 91 | 92 | geneSet <- object@geneSets[[geneSetID]] 93 | exponent <- object@params[["exponent"]] 94 | df <- gseaScores(geneList, geneSet, exponent, fortify=TRUE) 95 | df$ymin <- 0 96 | df$ymax <- 0 97 | pos <- df$position == 1 98 | h <- diff(range(df$runningScore))/20 99 | df$ymin[pos] <- -h 100 | df$ymax[pos] <- h 101 | df$geneList <- geneList 102 | if (length(object@gene2Symbol) == 0) { 103 | df$gene <- names(geneList) 104 | } else { 105 | df$gene <- object@gene2Symbol[names(geneList)] 106 | } 107 | 108 | df$Description <- object@result[geneSetID, "Description"] 109 | return(df) 110 | } 111 | 112 | gseaScores <- getFromNamespace("gseaScores", "DOSE") 113 | 114 | 115 | get_gsdata <- function(x, geneSetID) { 116 | if (length(geneSetID) == 1) { 117 | gsdata <- gsInfo(x, geneSetID) 118 | return(gsdata) 119 | } 120 | 121 | lapply(geneSetID, gsInfo, object = x) |> 122 | yulab.utils::rbindlist() 123 | } 124 | 125 | ##' Horizontal plot for GSEA result 126 | ##' 127 | ##' 128 | ##' @title hplot 129 | ##' @param x gseaResult object 130 | ##' @param geneSetID gene set ID 131 | ##' @return horizontal plot 132 | ##' @export 133 | ##' @author Guangchuang Yu 134 | hplot <- function(x, geneSetID) { 135 | 136 | if (!inherits(x, "gseaResult")) { 137 | stop("hplot only work for GSEA result") 138 | } 139 | 140 | gsdata <- get_gsdata(x, geneSetID) 141 | 142 | 143 | ggplot(gsdata, aes(.data$x, .data$runningScore)) + 144 | ggHoriPlot::geom_horizon(origin='min', horizonscale=4) + 145 | facet_grid(Description~.) + 146 | #ggHoriPlot::scale_fill_hcl(palette = 'Peach', reverse = TRUE) + 147 | ggHoriPlot::scale_fill_hcl(palette = 'BluGrn', reverse = TRUE) + 148 | theme_minimal() + 149 | ggfun::theme_noyaxis() + 150 | theme( 151 | panel.spacing.y=unit(0, "lines"), 152 | strip.text.y = element_text(angle = 0), 153 | legend.position = 'none', 154 | panel.border = element_blank(), 155 | panel.grid = element_blank(), 156 | ) + 157 | xlab(NULL) + 158 | ylab(NULL) 159 | } 160 | 161 | ##' GSEA plot that mimic the plot generated by broad institute's GSEA software 162 | ##' 163 | ##' 164 | ##' @title gseaplot2 165 | ##' @param x gseaResult object 166 | ##' @param geneSetID gene set ID 167 | ##' @param title plot title 168 | ##' @param color color of running enrichment score line 169 | ##' @param base_size base font size 170 | ##' @param rel_heights relative heights of subplots 171 | ##' @param subplots which subplots to be displayed 172 | ##' @param pvalue_table whether add pvalue table 173 | ##' @param ES_geom geom for plotting running enrichment score, 174 | ##' one of 'line' or 'dot' 175 | ##' @return plot 176 | ##' @export 177 | ##' @importFrom ggplot2 theme_classic 178 | ##' @importFrom ggplot2 element_line 179 | ##' @importFrom ggplot2 element_text 180 | ##' @importFrom ggplot2 element_blank 181 | ##' @importFrom ggplot2 element_rect 182 | ##' @importFrom ggplot2 scale_x_continuous 183 | ##' @importFrom ggplot2 scale_y_continuous 184 | ##' @importFrom ggplot2 scale_color_manual 185 | ##' @importFrom ggplot2 theme_void 186 | ##' @importFrom ggplot2 geom_rect 187 | ##' @importFrom ggplot2 margin 188 | ##' @importFrom ggplot2 annotation_custom 189 | ##' @importFrom stats quantile 190 | ##' @importFrom RColorBrewer brewer.pal 191 | ##' @author Guangchuang Yu 192 | gseaplot2 <- function(x, geneSetID, title = "", color="green", base_size = 11, 193 | rel_heights=c(1.5, .5, 1), subplots = 1:3, 194 | pvalue_table = FALSE, ES_geom="line") { 195 | ES_geom <- match.arg(ES_geom, c("line", "dot")) 196 | 197 | geneList <- position <- NULL ## to satisfy codetool 198 | 199 | gsdata <- get_gsdata(x, geneSetID) 200 | 201 | p <- ggplot(gsdata, aes_(x = ~x)) + xlab(NULL) + 202 | theme_classic(base_size) + 203 | theme(panel.grid.major = element_line(colour = "grey92"), 204 | panel.grid.minor = element_line(colour = "grey92"), 205 | panel.grid.major.y = element_blank(), 206 | panel.grid.minor.y = element_blank()) + 207 | scale_x_continuous(expand=c(0,0)) 208 | 209 | if (ES_geom == "line") { 210 | es_layer <- geom_line(aes_(y = ~runningScore, color= ~Description), 211 | size=1) 212 | } else { 213 | es_layer <- geom_point(aes_(y = ~runningScore, color= ~Description), 214 | size=1, data = subset(gsdata, position == 1)) 215 | } 216 | 217 | p.res <- p + es_layer + 218 | theme(legend.position = c(.8, .8), legend.title = element_blank(), 219 | legend.background = element_rect(fill = "transparent")) 220 | 221 | p.res <- p.res + ylab("Running Enrichment Score") + 222 | theme(axis.text.x=element_blank(), 223 | axis.ticks.x=element_blank(), 224 | axis.line.x=element_blank(), 225 | plot.margin=margin(t=.2, r = .2, b=0, l=.2, unit="cm")) 226 | 227 | i <- 0 228 | for (term in unique(gsdata$Description)) { 229 | idx <- which(gsdata$ymin != 0 & gsdata$Description == term) 230 | gsdata[idx, "ymin"] <- i 231 | gsdata[idx, "ymax"] <- i + 1 232 | i <- i + 1 233 | } 234 | p2 <- ggplot(gsdata, aes_(x = ~x)) + 235 | geom_linerange(aes_(ymin=~ymin, ymax=~ymax, color=~Description)) + 236 | xlab(NULL) + ylab(NULL) + theme_classic(base_size) + 237 | theme(legend.position = "none", 238 | plot.margin = margin(t=-.1, b=0,unit="cm"), 239 | axis.ticks = element_blank(), 240 | axis.text = element_blank(), 241 | axis.line.x = element_blank()) + 242 | scale_x_continuous(expand=c(0,0)) + 243 | scale_y_continuous(expand=c(0,0)) 244 | 245 | if (length(geneSetID) == 1) { 246 | ## geneList <- gsdata$geneList 247 | ## j <- which.min(abs(geneList)) 248 | ## v1 <- quantile(geneList[1:j], seq(0,1, length.out=6))[1:5] 249 | ## v2 <- quantile(geneList[j:length(geneList)], seq(0,1, length.out=6))[1:5] 250 | 251 | ## v <- sort(c(v1, v2)) 252 | ## inv <- findInterval(geneList, v) 253 | 254 | v <- seq(1, sum(gsdata$position), length.out=9) 255 | inv <- findInterval(rev(cumsum(gsdata$position)), v) 256 | if (min(inv) == 0) inv <- inv + 1 257 | 258 | col <- c(rev(brewer.pal(5, "Blues")), brewer.pal(5, "Reds")) 259 | 260 | ymin <- min(p2$data$ymin) 261 | yy <- max(p2$data$ymax - p2$data$ymin) * .3 262 | xmin <- which(!duplicated(inv)) 263 | xmax <- xmin + as.numeric(table(inv)[as.character(unique(inv))]) 264 | d <- data.frame(ymin = ymin, ymax = yy, 265 | xmin = xmin, 266 | xmax = xmax, 267 | col = col[unique(inv)]) 268 | p2 <- p2 + geom_rect( 269 | aes_(xmin=~xmin, 270 | xmax=~xmax, 271 | ymin=~ymin, 272 | ymax=~ymax, 273 | fill=~I(col)), 274 | data=d, 275 | alpha=.9, 276 | inherit.aes=FALSE) 277 | } 278 | 279 | ## p2 <- p2 + 280 | ## geom_rect(aes(xmin=x-.5, xmax=x+.5, fill=geneList), 281 | ## ymin=ymin, ymax = ymin + yy, alpha=.5) + 282 | ## theme(legend.position="none") + 283 | ## scale_fill_gradientn(colors=color_palette(c("blue", "red"))) 284 | 285 | df2 <- p$data #data.frame(x = which(p$data$position == 1)) 286 | df2$y <- p$data$geneList[df2$x] 287 | p.pos <- p + geom_segment(data=df2, aes_(x=~x, xend=~x, y=~y, yend=0), 288 | color="grey") 289 | p.pos <- p.pos + ylab("Ranked List Metric") + 290 | xlab("Rank in Ordered Dataset") + 291 | theme(plot.margin=margin(t = -.1, r = .2, b=.2, l=.2, unit="cm")) 292 | 293 | if (!is.null(title) && !is.na(title) && title != "") 294 | p.res <- p.res + ggtitle(title) 295 | 296 | if (length(color) == length(geneSetID)) { 297 | p.res <- p.res + scale_color_manual(values=color) 298 | if (length(color) == 1) { 299 | p.res <- p.res + theme(legend.position = "none") 300 | p2 <- p2 + scale_color_manual(values = "black") 301 | } else { 302 | p2 <- p2 + scale_color_manual(values = color) 303 | } 304 | } 305 | 306 | if (pvalue_table) { 307 | pd <- x[geneSetID, c("Description", "pvalue", "p.adjust")] 308 | # pd <- pd[order(pd[,1], decreasing=FALSE),] 309 | rownames(pd) <- pd$Description 310 | 311 | pd <- pd[,-1] 312 | # pd <- round(pd, 4) 313 | for (i in seq_len(ncol(pd))) { 314 | pd[, i] <- format(pd[, i], digits = 4) 315 | } 316 | tp <- tableGrob2(pd, p.res) 317 | 318 | p.res <- p.res + theme(legend.position = "none") + 319 | annotation_custom(tp, 320 | xmin = quantile(p.res$data$x, .5), 321 | xmax = quantile(p.res$data$x, .95), 322 | ymin = quantile(p.res$data$runningScore, .75), 323 | ymax = quantile(p.res$data$runningScore, .9)) 324 | } 325 | 326 | 327 | plotlist <- list(p.res, p2, p.pos)[subplots] 328 | n <- length(plotlist) 329 | plotlist[[n]] <- plotlist[[n]] + 330 | theme(axis.line.x = element_line(), 331 | axis.ticks.x=element_line(), 332 | axis.text.x = element_text()) 333 | 334 | if (length(subplots) == 1) 335 | return(plotlist[[1]] + theme(plot.margin=margin(t=.2, r = .2, b=.2, 336 | l=.2, unit="cm"))) 337 | 338 | 339 | if (length(rel_heights) > length(subplots)) 340 | rel_heights <- rel_heights[subplots] 341 | 342 | # aplot::plot_list(gglist = plotlist, ncol=1, heights=rel_heights) 343 | aplot::gglist(gglist = plotlist, ncol=1, heights=rel_heights) 344 | } 345 | 346 | 347 | ##' plot ranked list of genes with running enrichment score as bar height 348 | ##' 349 | ##' 350 | ##' @title gsearank 351 | ##' @param x gseaResult object 352 | ##' @param geneSetID gene set ID 353 | ##' @param title plot title 354 | ##' @param output one of 'plot' or 'table' (for exporting data) 355 | ##' @return ggplot object 356 | ##' @importFrom ggplot2 geom_segment 357 | ##' @importFrom ggplot2 theme_minimal 358 | ##' @export 359 | ##' @author Guangchuang Yu 360 | gsearank <- function(x, geneSetID, title="", output = "plot") { 361 | output <- match.arg(output, c("plot", "table")) 362 | 363 | position <- NULL 364 | gsdata <- gsInfo(x, geneSetID) 365 | gsdata <- subset(gsdata, position == 1) 366 | 367 | if (output == "table") { 368 | res <- gsdata[, c("gene", "x", "runningScore")] 369 | if (x[geneSetID, "NES"] > 0) { 370 | res$core <- "NO" 371 | res$core[1:which.max(gsdata$runningScore)] <- "YES" 372 | } else { 373 | res$core <- "NO" 374 | res$core[which.min(gsdata$runningScore):nrow(res)] <- "YES" 375 | } 376 | names(res) <- c("gene", "rank in geneList", "running ES", "core enrichment") 377 | rownames(res) <- NULL 378 | return(res) 379 | } 380 | 381 | p <- ggplot(gsdata, aes_(x = ~x, y = ~runningScore)) + 382 | geom_segment(aes_(xend=~x, yend=0)) + 383 | ggtitle(title) + 384 | xlab("Position in the Ranked List of Genes") + 385 | ylab("Running Enrichment Score") + 386 | theme_minimal() 387 | return(p) 388 | } 389 | 390 | 391 | ##' label genes in running score plot 392 | ##' 393 | ##' 394 | ##' @title geom_gsea_gene 395 | ##' @param genes selected genes to be labeled 396 | ##' @param mapping aesthetic mapping, default is NULL 397 | ##' @param geom geometric layer to plot the gene labels, default is geom_text 398 | ##' @param ... additional parameters passed to the 'geom' 399 | ##' @param geneSet choose which gene set(s) to be label if the plot contains multiple gene sets 400 | ##' @return ggplot object 401 | ##' @importFrom rlang .data 402 | ##' @export 403 | ##' @author Guangchuang Yu 404 | geom_gsea_gene <- function(genes, mapping=NULL, geom = ggplot2::geom_text, ..., geneSet = NULL) { 405 | default_mapping <- aes_(x=~x, y=~runningScore, label=~gene) 406 | if (is.null(mapping)) { 407 | mapping <- default_mapping 408 | } else { 409 | mapping <- modifyList(default_mapping, mapping) 410 | } 411 | if (is.null(geneSet)) { 412 | data <- ggtree::td_filter(.data$gene %in% genes) 413 | } else { 414 | data <- ggtree::td_filter(.data$gene %in% genes & .data$Description %in% geneSet) 415 | } 416 | 417 | geom(mapping = mapping, data = data, ...) 418 | } 419 | 420 | -------------------------------------------------------------------------------- /R/heatplot.R: -------------------------------------------------------------------------------- 1 | ##' @rdname heatplot 2 | ##' @exportMethod heatplot 3 | setMethod("heatplot", signature(x = "enrichResult"), 4 | function(x, showCategory = 30, ...) { 5 | heatplot.enrichResult(x, showCategory, ...) 6 | }) 7 | 8 | ##' @rdname heatplot 9 | ##' @exportMethod heatplot 10 | setMethod("heatplot", signature(x = "gseaResult"), 11 | function(x, showCategory = 30, ...) { 12 | heatplot.enrichResult(x, showCategory, ...) 13 | }) 14 | 15 | 16 | 17 | ##' @rdname heatplot 18 | ##' @importFrom ggplot2 geom_tile 19 | ##' @importFrom ggplot2 theme_minimal 20 | ##' @importFrom ggplot2 theme 21 | ##' @importFrom ggplot2 element_blank 22 | ##' @importFrom ggplot2 element_text 23 | ##' @importFrom ggplot2 scale_y_discrete 24 | ##' @importFrom ggplot2 scale_fill_gradient2 25 | ##' @importFrom rlang check_installed 26 | ##' @param label_format a numeric value sets wrap length, alternatively a 27 | ##' custom function to format axis labels. 28 | ##' @param symbol symbol of the nodes, one of "rect"(the default) and "dot" 29 | ##' by default wraps names longer that 30 characters 30 | ##' @param pvalue pvalue of genes 31 | ##' @author Guangchuang Yu 32 | heatplot.enrichResult <- function(x, showCategory = 30, symbol = "rect", foldChange = NULL, 33 | pvalue = NULL, label_format = 30) { 34 | 35 | symbol <- match.arg(symbol, c("rect", "dot")) 36 | label_func <- default_labeller(label_format) 37 | if(is.function(label_format)) { 38 | label_func <- label_format 39 | } 40 | 41 | n <- update_n(x, showCategory) 42 | geneSets <- extract_geneSets(x, n) 43 | foldChange <- fc_readable(x, foldChange) 44 | pvalue <- fc_readable(x, pvalue) 45 | d <- list2df(geneSets) 46 | if (!is.null(foldChange)) { 47 | d$foldChange <- foldChange[as.character(d[,2])] 48 | } 49 | 50 | if (!is.null(pvalue)) { 51 | d$pvalue <- pvalue[as.character(d[,2])] 52 | } 53 | 54 | p <- ggplot(d, aes_(~Gene, ~categoryID)) 55 | 56 | if (symbol == "rect") { 57 | p <- p + geom_tile(color = 'white') 58 | } 59 | 60 | get_dotp <-function(p, foldChange, pvalue) { 61 | if (is.null(foldChange) & is.null(pvalue)) { 62 | p <- p + geom_point(color = 'black', shape = 21, fill = "black", size = 5) 63 | return(p) 64 | } 65 | 66 | if (!is.null(foldChange) & !is.null(pvalue)) { 67 | p <- p + geom_point(color = 'black', shape = 21) 68 | return(p) 69 | } 70 | 71 | if (is.null(foldChange)) { 72 | p <- p + geom_point(color = 'black', shape = 21, fill = "black") 73 | } else { 74 | p <- p + geom_point(color = 'black', shape = 21, size = 5) 75 | } 76 | 77 | return(p) 78 | } 79 | # copy from https://stackoverflow.com/questions/11053899/how-to-get-a-reversed-log10-scale-in-ggplot2 80 | reverselog_trans <- function(base = exp(1)) { 81 | trans <- function(x) -log(x, base) 82 | 83 | check_installed('scales', 'for `heatplot()`.') 84 | 85 | inv <- function(x) base^(-x) 86 | scales::trans_new(paste0("reverselog-", format(base)), trans, inv, 87 | scales::log_breaks(base = base), 88 | domain = c(1e-100, Inf)) 89 | } 90 | 91 | if (symbol == "dot") { 92 | p <- get_dotp(p, foldChange, pvalue) 93 | ## only dot need size(pvalue) parameter 94 | if (!is.null(pvalue)) { 95 | p <- p + aes_(size = ~pvalue) + 96 | scale_size_continuous(range=c(3, 8), 97 | trans = reverselog_trans(10)) 98 | } 99 | } 100 | 101 | if (!is.null(foldChange)) { 102 | p <- p + aes_(fill = ~foldChange) + 103 | set_enrichplot_color(colors = get_enrichplot_color(3), type = "fill") 104 | # scale_fill_gradient2(name = "fold change", low = "#327eba", 105 | # mid = "white", high = "#e06663") + 106 | 107 | } 108 | 109 | 110 | p + xlab(NULL) + ylab(NULL) + theme_minimal() + 111 | scale_y_discrete(labels = label_func) + 112 | theme(panel.grid.major = element_blank(), 113 | axis.text.x=element_text(angle = 60, hjust = 1)) 114 | } 115 | 116 | -------------------------------------------------------------------------------- /R/method-fortify.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | ##' convert compareClusterResult to a data.frame that ready for plot 4 | ##' 5 | ##' 6 | ##' @rdname fortify 7 | ##' @title fortify 8 | ##' @param includeAll logical 9 | ##' @return data.frame 10 | ##' @importFrom ggplot2 fortify 11 | ##' @importFrom plyr ddply 12 | ##' @importFrom plyr mdply 13 | ##' @importFrom plyr . 14 | ##' @method fortify compareClusterResult 15 | ##' @export 16 | ##' @author Guangchuang Yu 17 | fortify.compareClusterResult <- function(model, data, showCategory=5, 18 | by="geneRatio", split=NULL, 19 | includeAll=TRUE, ...) { 20 | clProf.df <- as.data.frame(model) 21 | .split <- split 22 | if ("core_enrichment" %in% colnames(clProf.df)) { 23 | clProf.df$Count <- str_count(clProf.df$core_enrichment, "/") 24 | clProf.df$.sign <- "activated" 25 | clProf.df$.sign[clProf.df$NES < 0] <- "suppressed" 26 | clProf.df$GeneRatio <- clProf.df$Count / clProf.df$setSize 27 | } 28 | ## get top 5 (default) categories of each gene cluster. 29 | if (is.null(showCategory)) { 30 | result <- clProf.df 31 | } else if(is.numeric(showCategory)){ 32 | Cluster <- NULL # to satisfy codetools 33 | 34 | topN <- function(res, showCategory) { 35 | ddply(.data = res, 36 | .variables = .(Cluster), 37 | .fun = function(df, N) { 38 | if (length(df$Count) > N) { 39 | if (any(colnames(df) == "pvalue")) { 40 | idx <- order(df$pvalue, decreasing=FALSE)[1:N] 41 | } else { 42 | ## for groupGO 43 | idx <- order(df$Count, decreasing=T)[1:N] 44 | } 45 | return(df[idx,]) 46 | } else { 47 | return(df) 48 | } 49 | }, 50 | N=showCategory 51 | ) 52 | 53 | } 54 | 55 | if (!is.null(.split) && .split %in% colnames(clProf.df)) { 56 | lres <- split(clProf.df, as.character(clProf.df[, .split])) 57 | lres <- lapply(lres, topN, showCategory = showCategory) 58 | result <- do.call('rbind', lres) 59 | } else { 60 | result <- topN(clProf.df, showCategory) 61 | } 62 | 63 | } else { 64 | result <- subset(clProf.df, Description %in% showCategory) 65 | } 66 | 67 | ID <- NULL 68 | if (includeAll == TRUE) { 69 | result <- subset(clProf.df, ID %in% result$ID) 70 | } 71 | 72 | ## remove zero count 73 | result$Description <- as.character(result$Description) ## un-factor 74 | GOlevel <- result[,c("ID", "Description")] ## GO ID and Term 75 | GOlevel <- unique(GOlevel) 76 | 77 | 78 | 79 | result <- result[result$Count != 0, ] 80 | result$Description <- factor(result$Description, 81 | levels=unique(rev(GOlevel[,2]))) 82 | if (by=="rowPercentage") { 83 | Description <- Count <- NULL # to satisfy codetools 84 | result <- ddply(result, 85 | .(Description), 86 | transform, 87 | Percentage = Count/sum(Count), 88 | Total = sum(Count)) 89 | 90 | ## label GO Description with gene counts. 91 | x <- mdply(result[, c("Description", "Total")], paste, sep=" (") 92 | y <- sapply(x[,3], paste, ")", sep="") 93 | result$Description <- y 94 | 95 | ## restore the original order of GO Description 96 | xx <- result[,c(2,3)] 97 | xx <- unique(xx) 98 | rownames(xx) <- xx[,1] 99 | Termlevel <- xx[as.character(GOlevel[,1]),2] 100 | 101 | ##drop the *Total* column 102 | result <- result[, colnames(result) != "Total"] 103 | 104 | result$Description <- factor(result$Description, 105 | levels=unique(rev(Termlevel))) 106 | 107 | } else if (by == "count") { 108 | result$GeneRatio <- DOSE::parse_ratio(result$GeneRatio) 109 | } else if (by == "geneRatio") { 110 | ## for result of ORA 111 | # if (class(result$GeneRatio) == "character" && grep("/", result$GeneRatio[1])) { 112 | if (inherits(result$GeneRatio, "character") && grep("/", result$GeneRatio[1])) { 113 | gcsize <- as.numeric(sub("^\\d+/", "", as.character(result$GeneRatio))) 114 | result$GeneRatio <- DOSE::parse_ratio(result$GeneRatio) 115 | if (("ONTOLOGY" %in% colnames(result)) && (length(unique(result$ONTOLOGY)) > 1)){ 116 | # do nothing 117 | } else { 118 | cluster <- paste(as.character(result$Cluster),"\n", "(", gcsize, ")", 119 | sep="") 120 | lv <- unique(cluster)[order(as.numeric(unique(result$Cluster)))] 121 | result$Cluster <- factor(cluster, levels = lv) 122 | } 123 | } 124 | 125 | } else { 126 | ## nothing 127 | } 128 | return(result) 129 | } 130 | 131 | 132 | ##' convert enrichResult object for ggplot2 133 | ##' 134 | ##' 135 | ##' @title fortify 136 | ##' @rdname fortify 137 | ##' @param model 'enrichResult' or 'compareClusterResult' object 138 | ##' @param data not use here 139 | ##' @param showCategory Category numbers to show 140 | ##' @param by one of Count and GeneRatio 141 | ##' @param order logical 142 | ##' @param drop logical 143 | ##' @param split separate result by 'split' variable 144 | ##' @param ... additional parameter 145 | ##' @return data.frame 146 | ##' @importFrom ggplot2 fortify 147 | ##' @method fortify enrichResult 148 | ##' @export 149 | fortify.enrichResult <- function(model, data, showCategory=5, by = "Count", 150 | order=FALSE, drop=FALSE, split=NULL, ...) { 151 | fortify_internal(model, data, showCategory, by, order, drop, split, ...) 152 | } 153 | 154 | ##' @method fortify gseaResult 155 | ##' @export 156 | fortify.gseaResult <- function(model, data, showCategory=5, by = "Count", 157 | order=FALSE, drop=FALSE, split=NULL, ...) { 158 | fortify_internal(model, data, showCategory, by, order, drop, split, ...) 159 | } 160 | 161 | 162 | fortify_internal <- function(model, data, showCategory=5, by = "Count", 163 | order=FALSE, drop=FALSE, split=NULL, ...) { 164 | res <- as.data.frame(model) 165 | res <- res[!is.na(res$Description), ] 166 | if (inherits(model, "gseaResult")) { 167 | res$Count <- str_count(res$core_enrichment, "/") 168 | res$.sign <- "activated" 169 | res$.sign[res$NES < 0] <- "suppressed" 170 | } 171 | if (drop) { 172 | res <- res[res$Count != 0, ] 173 | } 174 | if (inherits(model, "gseaResult")) { 175 | res$GeneRatio <- res$Count / res$setSize 176 | } else if (inherits(model, "enrichResult")) { 177 | res$GeneRatio <- parse_ratio(res$GeneRatio) 178 | if ("BgRatio" %in% colnames(res)) { 179 | ## groupGO output doesn't have this column 180 | res$BgRatio <- parse_ratio(res$BgRatio) 181 | } 182 | } 183 | 184 | if (order) { 185 | if (by == "Count") { 186 | idx <- order(res$Count, decreasing=TRUE) 187 | } else { 188 | idx <- order(res$GeneRatio, decreasing=TRUE) 189 | } 190 | res <- res[idx,] 191 | } 192 | 193 | topN <- function(res, showCategory) { 194 | if ( is.numeric(showCategory) ) { 195 | if ( showCategory <= nrow(res) ) { 196 | res <- res[1:showCategory,] 197 | } 198 | } else { ## selected categories 199 | res <- res[res$Description %in% showCategory,] 200 | } 201 | return(res) 202 | } 203 | 204 | if (is.null(split)) { 205 | res <- topN(res, showCategory) 206 | } else { 207 | lres <- split(res, as.character(res[, split])) 208 | lres <- lapply(lres, topN, showCategory = showCategory) 209 | res <- do.call('rbind', lres) 210 | } 211 | 212 | res$Description <- factor(res$Description, 213 | levels=rev(unique(res$Description))) 214 | 215 | return(res) 216 | } 217 | 218 | str_count <- function(string, pattern="") { 219 | sapply(string, FUN = function(i) length(unlist(strsplit(i, split = pattern)))) 220 | } 221 | 222 | parse_ratio <- function(ratio) { 223 | gsize <- as.numeric(sub("/\\d+$", "", as.character(ratio))) 224 | gcsize <- as.numeric(sub("^\\d+/", "", as.character(ratio))) 225 | return(gsize/gcsize) 226 | } 227 | 228 | 229 | -------------------------------------------------------------------------------- /R/method-ggplot-add.R: -------------------------------------------------------------------------------- 1 | ##' @importFrom ggplot2 ggplot_add 2 | ##' @method ggplot_add autofacet 3 | ##' @export 4 | ggplot_add.autofacet <- function(object, plot, object_name) { 5 | d <- plot$data 6 | nn <- names(d) 7 | if ('category' %in% nn) { 8 | var <- "category" 9 | } else if ('ONTOLOGY' %in% nn) { 10 | var <- 'ONTOLOGY' 11 | } else { 12 | message("not supported") 13 | return(plot) 14 | } 15 | 16 | if (!is.null(object$levels)) { 17 | d[[var]] <- factor(d[[var]], levels = object$levels) 18 | plot$data <- d 19 | } 20 | if (object$by == 'row') { 21 | obj <- facet_grid(.data[[var]] ~ ., scales=object$scales) 22 | } else { 23 | obj <- facet_grid(. ~ .data[[var]], scales=object$scales) 24 | } 25 | ggplot_add(obj, plot, object_name) 26 | } 27 | -------------------------------------------------------------------------------- /R/method-print.r: -------------------------------------------------------------------------------- 1 | ##' @method print enrichplotDot 2 | ##' @export 3 | print.enrichplotDot <- function(x, ...) { 4 | p <- ggfun::set_point_legend_shape(x) 5 | class(p) <- class(p)[-1] 6 | print(p) 7 | } 8 | -------------------------------------------------------------------------------- /R/pairwise_termsim.R: -------------------------------------------------------------------------------- 1 | ##' @rdname pairwise_termsim 2 | ##' @exportMethod pairwise_termsim 3 | setMethod("pairwise_termsim", signature(x = "enrichResult"), 4 | function(x, method = "JC", semData = NULL, showCategory = 200) { 5 | pairwise_termsim.enrichResult(x, method = method, 6 | semData = semData, showCategory = showCategory) 7 | }) 8 | 9 | ##' @rdname pairwise_termsim 10 | ##' @exportMethod pairwise_termsim 11 | setMethod("pairwise_termsim", signature(x = "gseaResult"), 12 | function(x, method = "JC", semData = NULL, showCategory = 200) { 13 | pairwise_termsim.enrichResult(x, method = method, 14 | semData = semData, showCategory = showCategory) 15 | }) 16 | 17 | ##' @rdname pairwise_termsim 18 | ##' @exportMethod pairwise_termsim 19 | setMethod("pairwise_termsim", signature(x = "compareClusterResult"), 20 | function(x, method = "JC", semData = NULL, showCategory = 200) { 21 | pairwise_termsim.compareClusterResult(x, method = method, 22 | semData = semData, showCategory = showCategory) 23 | }) 24 | 25 | 26 | ##' @rdname pairwise_termsim 27 | pairwise_termsim.enrichResult <- function(x, method = "JC", semData = NULL, showCategory = 200) { 28 | y <- as.data.frame(x) 29 | geneSets <- geneInCategory(x) 30 | n <- update_n(x, showCategory) 31 | if (n == 0) stop("no enriched term found...") 32 | if (is.numeric(n)) { 33 | y <- y[1:n, ] 34 | } else { 35 | y <- y[match(n, y$Description),] 36 | n <- length(n) 37 | } 38 | 39 | x@termsim <- get_similarity_matrix(y = y, geneSets = geneSets, method = method, 40 | semData = semData) 41 | x@method <- method 42 | return(x) 43 | } 44 | 45 | 46 | ##' @rdname pairwise_termsim 47 | pairwise_termsim.compareClusterResult <- function(x, method = "JC", semData = NULL, 48 | showCategory = 200) { 49 | y <- fortify(x, showCategory=showCategory, includeAll=TRUE, split=NULL) 50 | y$Cluster <- sub("\n.*", "", y$Cluster) 51 | ## y_union <- get_y_union(y = y, showCategory = showCategory) 52 | if ("core_enrichment" %in% colnames(y)) { 53 | y$geneID <- y$core_enrichment 54 | } 55 | y_union <- merge_compareClusterResult(y) 56 | geneSets <- setNames(strsplit(as.character(y_union$geneID), "/", 57 | fixed = TRUE), 58 | y_union$ID) 59 | x@termsim <- get_similarity_matrix(y = y_union, geneSets = geneSets, method = method, 60 | semData = semData) 61 | x@method <- method 62 | return(x) 63 | } 64 | -------------------------------------------------------------------------------- /R/pmcplot.R: -------------------------------------------------------------------------------- 1 | ##' PubMed Central Trend plot 2 | ##' 3 | ##' 4 | ##' @title pmcplot 5 | ##' @param query query terms 6 | ##' @param period period of query in the unit of year 7 | ##' @param proportion If TRUE, use query_hits/all_hits, otherwise use query_hits 8 | ##' @return ggplot object 9 | ##' @importFrom purrr map_df 10 | ##' @importFrom rlang check_installed 11 | ## @importFrom europepmc epmc_hits_trend 12 | ##' @importFrom utils modifyList 13 | ##' @export 14 | ##' @author guangchuang yu 15 | pmcplot <- function(query, period, proportion = TRUE) { 16 | 17 | check_installed('europepmc', 'for `pmcplot()`.') 18 | 19 | res <- map_df(query, function(x) { 20 | period <- get("period", parent.env(parent.env(new.env()))) 21 | y <- europepmc::epmc_hits_trend(query = x, period = period) 22 | y$query <- x 23 | return(y) 24 | }) 25 | 26 | mapping <- aes_(x=~year, y = ~query_hits, color = ~query) 27 | ylab <- "Number of articles" 28 | if (proportion) { 29 | mapping <- modifyList(mapping, aes_(y = ~query_hits/all_hits)) 30 | ylab <- "Proportion of articles" 31 | } 32 | ggplot(res, mapping) + geom_line() + geom_point() + 33 | xlab(NULL) + ylab(ylab) 34 | } 35 | 36 | 37 | -------------------------------------------------------------------------------- /R/reexport.R: -------------------------------------------------------------------------------- 1 | #' @importFrom ggplot2 ggtitle 2 | #' @export 3 | ggplot2::ggtitle 4 | 5 | #' @importFrom ggplot2 facet_grid 6 | #' @export 7 | ggplot2::facet_grid 8 | 9 | #' @importFrom aplot plot_list 10 | #' @export 11 | aplot::plot_list 12 | 13 | #' @importFrom ggtangle cnetplot 14 | #' @export 15 | ggtangle::cnetplot 16 | 17 | 18 | #' @importFrom ggtangle geom_cnet_label 19 | #' @export 20 | ggtangle::geom_cnet_label 21 | 22 | -------------------------------------------------------------------------------- /R/ridgeplot.R: -------------------------------------------------------------------------------- 1 | ##' @rdname ridgeplot 2 | ##' @exportMethod ridgeplot 3 | setMethod("ridgeplot", signature(x = "gseaResult"), 4 | function(x, showCategory = 30, fill = "p.adjust", 5 | core_enrichment = TRUE, label_format = 30, ...) { 6 | ridgeplot.gseaResult(x, showCategory = showCategory, 7 | fill = fill, core_enrichment = core_enrichment, 8 | label_format = label_format, ...) 9 | }) 10 | 11 | 12 | ##' @rdname ridgeplot 13 | ##' @param orderBy The order of the Y-axis 14 | ##' @param decreasing logical. Should the orderBy order be increasing or decreasing? 15 | ##' @importFrom ggplot2 scale_fill_gradientn 16 | ##' @importFrom ggplot2 aes_string 17 | ##' @importFrom ggplot2 scale_x_reverse 18 | ##' @importFrom ggplot2 xlab 19 | ##' @importFrom ggplot2 ylab 20 | ##' @importFrom ggplot2 scale_y_discrete 21 | ##' @importFrom rlang check_installed 22 | ##' @author Guangchuang Yu 23 | ridgeplot.gseaResult <- function(x, showCategory=30, fill="p.adjust", 24 | core_enrichment = TRUE, label_format = 30, 25 | orderBy = "NES", decreasing = FALSE) { 26 | if (!is(x, "gseaResult")) 27 | stop("currently only support gseaResult") 28 | 29 | if (!fill %in% colnames(x@result)) { 30 | stop("'fill' variable not available ...") 31 | } 32 | 33 | ## geom_density_ridges <- get_fun_from_pkg('ggridges', 'geom_density_ridges') 34 | if (orderBy != 'NES' && !orderBy %in% colnames(x@result)) { 35 | message('wrong orderBy parameter; set to default `orderBy = "NES"`') 36 | orderBy <- "NES" 37 | } 38 | if (inherits(showCategory, 'numeric')) { 39 | selected <- seq_len(showCategory) 40 | } else if (inherits(showCategory, "character")) { 41 | ii <- match(showCategory, x@result$Description) 42 | if (all(is.na(ii))) { 43 | ii <- match(showCategory, x@result$ID) 44 | } 45 | ii <- ii[!is.na(ii)] 46 | selected <- x@result[ii, "ID"] 47 | } else { 48 | warning("showCategory should be a number of pathways or a vector of selected pathways") 49 | } 50 | 51 | if (core_enrichment) { 52 | gs2id <- geneInCategory(x)[selected] 53 | } else { 54 | gs2id <- x@geneSets[names(x@geneSets) %in% selected] 55 | } 56 | 57 | if (x@readable && length(x@gene2Symbol) > 0) { 58 | id <- match(names(x@geneList), names(x@gene2Symbol)) 59 | names(x@geneList) <- x@gene2Symbol[id] 60 | } 61 | 62 | gs2val <- lapply(gs2id, function(id) { 63 | res <- x@geneList[id] 64 | res <- res[!is.na(res)] 65 | }) 66 | 67 | nn <- names(gs2val) 68 | i <- match(nn, x$ID) 69 | nn <- x$Description[i] 70 | 71 | # j <- order(x$NES[i], decreasing=FALSE) 72 | j <- order(x@result[[orderBy]][i], decreasing = decreasing) 73 | len <- sapply(gs2val, length) 74 | gs2val.df <- data.frame(category = rep(nn, times=len), 75 | color = rep(x[i, fill], times=len), 76 | value = unlist(gs2val)) 77 | 78 | colnames(gs2val.df)[2] <- fill 79 | gs2val.df$category <- factor(gs2val.df$category, levels=nn[j]) 80 | 81 | label_func <- default_labeller(label_format) 82 | if(is.function(label_format)) { 83 | label_func <- label_format 84 | } 85 | 86 | check_installed('ggridges', 'for `ridgeplot()`.') 87 | 88 | ggplot(gs2val.df, aes_string(x="value", y="category", fill=fill)) + 89 | ggridges::geom_density_ridges() + 90 | # scale_fill_continuous(name = fill) + 91 | set_enrichplot_color(type = "fill", name = fill) + 92 | scale_y_discrete(labels = label_func) + 93 | ## scale_fill_gradientn(name = fill, colors=sig_palette, guide=guide_colorbar(reverse=TRUE)) + 94 | ## geom_vline(xintercept=0, color='firebrick', linetype='dashed') + 95 | xlab(NULL) + ylab(NULL) + theme_dose() 96 | } 97 | 98 | -------------------------------------------------------------------------------- /R/show-method.R: -------------------------------------------------------------------------------- 1 | ## ##' show method for \code{enrichResult} instance 2 | ## ##' 3 | ## ##' @name show 4 | ## ##' @docType methods 5 | ## ##' @rdname show-methods 6 | ## ##' 7 | ## ##' @title show method 8 | ## ##' @param object A \code{enrichResult} instance. 9 | ## ##' @return message 10 | ## ##' @importFrom utils str 11 | ## ##' @importFrom methods show 12 | ## ##' @exportMethod show 13 | ## ##' @usage show(object) 14 | ## ##' @examples 15 | ## ##' library(DOSE) 16 | ## ##' data(geneList) 17 | ## ##' de <- names(geneList)[1:100] 18 | ## ##' x <- enrichDO(de) 19 | ## ##' print(x) 20 | ## ##' @author Guangchuang Yu \url{https://guangchuangyu.github.io} 21 | ## setMethod("show", signature(object="enrichResult"), 22 | ## function (object){ 23 | ## cat("#\n# over-representation test\n#\n") 24 | ## cat("#...@organism", "\t", object@organism, "\n") 25 | ## cat("#...@ontology", "\t", object@ontology, "\n") 26 | ## kt <- object@keytype 27 | ## if (kt != "UNKNOWN") { 28 | ## cat("#...@keytype", "\t", kt, "\n") 29 | ## } 30 | ## cat("#...@gene", "\t") 31 | ## str(object@gene) 32 | ## cat("#...pvalues adjusted by", paste0("'", object@pAdjustMethod, "'"), 33 | ## paste0("with cutoff <", object@pvalueCutoff), "\n") 34 | ## cat(paste0("#...", nrow(object@result)), "enriched terms found\n") 35 | ## str(object@result) 36 | ## cat("#...Citation\n") 37 | ## if (object@ontology == "DO" || object@ontology == "DOLite" || object@ontology == "NCG") { 38 | ## citation_msg <- paste(" Guangchuang Yu, Li-Gen Wang, Guang-Rong Yan, Qing-Yu He. DOSE: an", 39 | ## " R/Bioconductor package for Disease Ontology Semantic and Enrichment", 40 | ## " analysis. Bioinformatics 2015, 31(4):608-609", sep="\n", collapse="\n") 41 | ## } else if (object@ontology == "Reactome") { 42 | ## citation_msg <- paste(" Guangchuang Yu, Qing-Yu He. ReactomePA: an R/Bioconductor package for", 43 | ## " reactome pathway analysis and visualization. Molecular BioSystems", 44 | ## " 2016, 12(2):477-479", sep="\n", collapse="\n") 45 | ## } else { 46 | ## citation_msg <- paste(" Guangchuang Yu, Li-Gen Wang, Yanyan Han and Qing-Yu He.", 47 | ## " clusterProfiler: an R package for comparing biological themes among", 48 | ## " gene clusters. OMICS: A Journal of Integrative Biology", 49 | ## " 2012, 16(5):284-287", sep="\n", collapse="\n") 50 | ## } 51 | ## cat(citation_msg, "\n\n") 52 | ## }) 53 | 54 | ## ##' show method for \code{gseaResult} instance 55 | ## ##' 56 | ## ##' @name show 57 | ## ##' @docType methods 58 | ## ##' @rdname show-methods 59 | ## ##' 60 | ## ##' @title show method 61 | ## ##' @return message 62 | ## ##' @importFrom methods show 63 | ## ##' @exportMethod show 64 | ## ##' @usage show(object) 65 | ## ##' @author Guangchuang Yu \url{https://guangchuangyu.github.io} 66 | ## setMethod("show", signature(object="gseaResult"), 67 | ## function (object){ 68 | ## params <- object@params 69 | ## cat("#\n# Gene Set Enrichment Analysis\n#\n") 70 | ## cat("#...@organism", "\t", object@organism, "\n") 71 | ## cat("#...@setType", "\t", object@setType, "\n") 72 | ## kt <- object@keytype 73 | ## if (kt != "UNKNOWN") { 74 | ## cat("#...@keytype", "\t", kt, "\n") 75 | ## } 76 | 77 | ## cat("#...@geneList", "\t") 78 | ## str(object@geneList) 79 | ## cat("#...nPerm", "\t", params$nPerm, "\n") 80 | ## cat("#...pvalues adjusted by", paste0("'", params$pAdjustMethod, "'"), 81 | ## paste0("with cutoff <", params$pvalueCutoff), "\n") 82 | ## cat(paste0("#...", nrow(object@result)), "enriched terms found\n") 83 | ## str(object@result) 84 | ## cat("#...Citation\n") 85 | ## if (object@setType == "DO" || object@setType == "DOLite" || object@setType == "NCG") { 86 | ## citation_msg <- paste(" Guangchuang Yu, Li-Gen Wang, Guang-Rong Yan, Qing-Yu He. DOSE: an", 87 | ## " R/Bioconductor package for Disease Ontology Semantic and Enrichment", 88 | ## " analysis. Bioinformatics 2015, 31(4):608-609", sep="\n", collapse="\n") 89 | ## } else if (object@setType == "Reactome") { 90 | ## citation_msg <- paste(" Guangchuang Yu, Qing-Yu He. ReactomePA: an R/Bioconductor package for", 91 | ## " reactome pathway analysis and visualization. Molecular BioSystems", 92 | ## " 2016, 12(2):477-479", sep="\n", collapse="\n") 93 | ## } else { 94 | ## citation_msg <- paste(" Guangchuang Yu, Li-Gen Wang, Yanyan Han and Qing-Yu He.", 95 | ## " clusterProfiler: an R package for comparing biological themes among", 96 | ## " gene clusters. OMICS: A Journal of Integrative Biology", 97 | ## " 2012, 16(5):284-287", sep="\n", collapse="\n") 98 | ## } 99 | ## cat(citation_msg, "\n\n") 100 | ## } 101 | ## ) 102 | 103 | -------------------------------------------------------------------------------- /R/ssplot.R: -------------------------------------------------------------------------------- 1 | ##' @rdname ssplot 2 | ##' @exportMethod ssplot 3 | setMethod("ssplot", signature(x = "enrichResult"), 4 | function(x, showCategory = 30, ...) { 5 | ssplot.enrichResult(x, showCategory = showCategory, ...) 6 | }) 7 | 8 | ##' @rdname ssplot 9 | ##' @exportMethod ssplot 10 | setMethod("ssplot", signature(x = "gseaResult"), 11 | function(x, showCategory = 30, ...) { 12 | ssplot.enrichResult(x, showCategory = showCategory, ...) 13 | }) 14 | 15 | ##' @rdname ssplot 16 | ##' @exportMethod ssplot 17 | setMethod("ssplot", signature(x = "compareClusterResult"), 18 | function(x, showCategory = 30, ...) { 19 | ssplot.compareClusterResult(x, showCategory = showCategory, 20 | ...) 21 | }) 22 | 23 | 24 | 25 | 26 | ##' @rdname ssplot 27 | ##' @param drfun The function used for dimension reduction, 28 | ##' e.g. stats::cmdscale (the default), vegan::metaMDS, or ape::pcoa. 29 | ##' @param dr.params list, the parameters of tidydr::dr. one of 'category', 'group', 'all' and 'none'. 30 | ##' @param ... additional parameters 31 | ##' 32 | ##' additional parameters can refer the following parameters. 33 | ##' \itemize{ 34 | ## \item \code{coords} a data.frame with two columns: 'x' for X-axis coordinate and 'y' for Y-axis coordinate. 35 | ##' \item \code{color} Variable that used to color enriched terms, e.g. 'pvalue','p.adjust' or 'qvalue'. 36 | ##' the starting position of each text label. 37 | ##' \item \code{size_edge} Scale of line width. 38 | ##' \item \code{min_edge} The minimum similarity threshold for whether 39 | ##' two nodes are connected, should between 0 and 1, default value is 0.2. 40 | ## \item \code{cex_label_category} Scale of category node label size. 41 | ##' \item \code{size_category} Number indicating the amount by which plotting category 42 | ##' nodes should be scaled relative to the default. 43 | ## \item \code{shadowtext} a logical value, whether to use shadow font. 44 | ##' \item \code{label_style} style of group label, one of "shadowtext" and "ggforce". 45 | ## \item \code{repel whether} to correct the position of the label. Defaults to FALSE. 46 | ##' \item \code{group} Logical, if TRUE, the grouping legend will be displayed. 47 | ##' The default is FALSE. 48 | ## \item \code{cex_label_group} Numeric, scale of group labels size, the default value is 1. 49 | ##' \item \code{nWords} Numeric, the number of words in the cluster tags, the default value is 4. 50 | ##' \item \code{label_format} a numeric value sets wrap length, alternatively a 51 | ##' custom function to format axis labels. 52 | ##' \item \code{clusterFunction} function of Clustering method, such as stats::kmeans(the default), 53 | ##' cluster::clara, cluster::fanny or cluster::pam. 54 | ##' \item \code{nCluster} Numeric, the number of clusters, 55 | ##' the default value is square root of the number of nodes. 56 | ##' } 57 | ##' 58 | ##' additional parameters can refer the emapplot function: \link{emapplot}. 59 | ssplot.enrichResult <- function(x, showCategory = 30, 60 | drfun = NULL, 61 | dr.params = list(), 62 | group = TRUE, 63 | node_label = "group", 64 | ...) { 65 | if (is.null(drfun)) { 66 | drfun = stats::cmdscale 67 | dr.params = list(eig = TRUE) 68 | } 69 | if (is.character(drfun)) { 70 | drfun <- eval(parse(text=drfun)) 71 | } 72 | 73 | drResult <- get_drResult(x = x, showCategory = showCategory, 74 | drfun = drfun, dr.params = dr.params) 75 | coords <- drResult$drdata[, c(1, 2)] 76 | colnames(coords) <- c("x", "y") 77 | rownames(coords) <- attr(drResult$data, "Labels") 78 | p <- emapplot(x = x, showCategory = showCategory, 79 | group = group, 80 | node_label = node_label, 81 | ...) 82 | 83 | ## Set axis label according to drfun 84 | p <- adj_axis(p = p, drResult = drResult) 85 | return(p + theme_classic()) 86 | } 87 | 88 | 89 | 90 | 91 | #' @rdname ssplot 92 | #' @param pie one of 'equal' or 'Count' to set the slice ratio of the pies 93 | #' @importFrom ggplot2 theme_classic 94 | #' @importFrom ggplot2 coord_equal 95 | #' @importClassesFrom DOSE compareClusterResult 96 | # @param cex_pie2axis It is used to adjust the relative size of the pie chart on the coordinate axis, 97 | # the default value is 0.0125. 98 | #' @importFrom stats setNames 99 | ssplot.compareClusterResult <- function(x, showCategory = 30, 100 | #split = NULL, 101 | pie = "equal", 102 | drfun = NULL, 103 | #cex_pie2axis = 0.0125, 104 | dr.params = list(), 105 | group = TRUE, 106 | node_label = "group", ...) { 107 | if (is.null(drfun)) { 108 | drfun = stats::cmdscale 109 | dr.params = list(eig = TRUE) 110 | } 111 | 112 | if (is.character(drfun)) { 113 | drfun <- eval(parse(text=drfun)) 114 | } 115 | split = NULL 116 | drResult <- get_drResult(x = x, showCategory = showCategory, 117 | split = split, pie = pie, drfun = drfun, dr.params = dr.params) 118 | coords <- drResult$drdata[, c(1, 2)] 119 | colnames(coords) <- c("x", "y") 120 | rownames(coords) <- attr(drResult$data, "Labels") 121 | p <- emapplot(x, showCategory = showCategory, 122 | coords = coords, 123 | split = split, pie = pie, 124 | #with_edge = with_edge, 125 | #cex_pie2axis = cex_pie2axis, 126 | group = group, 127 | node_label = node_label, ...) 128 | ## Set axis label according to the method parameter 129 | p <- adj_axis(p = p, drResult = drResult) 130 | return(p + theme_classic()) 131 | } 132 | 133 | 134 | ##' Get a distance matrix 135 | ##' 136 | ##' @param x enrichment result. 137 | ##' @param showCategory number of enriched terms to display. 138 | ##' @param split separate result by 'category' variable. 139 | ##' @param pie proportion of clusters in the pie chart. 140 | ##' @noRd 141 | build_dist <- function(x, showCategory, split = NULL, pie = NULL) { 142 | sim = get_pairwise_sim(x = x, showCategory = showCategory, 143 | split = split, pie = pie) 144 | ## If the similarity between the two terms is 1, 145 | ## an error will be reported in some method, so fine-tuning. 146 | sim[which(sim == 1)] <- 0.99999 147 | for (i in seq_len(nrow(sim))) sim[i, i] <- 1 148 | stats::as.dist(1- sim) 149 | } 150 | 151 | 152 | ##' Get a similarity matrix 153 | ##' 154 | ##' @param x enrichment result. 155 | ##' @param showCategory number of enriched terms to display. 156 | ##' @param split separate result by 'category' variable. 157 | ##' @param pie proportion of clusters in the pie chart. 158 | ##' @noRd 159 | get_pairwise_sim <- function(x, showCategory, split = NULL, pie = NULL) { 160 | # if (class(x) == "compareClusterResult") { 161 | if (inherits(x, "compareClusterResult")) { 162 | # y <- get_selected_category(showCategory, enrichResult, split) 163 | y <- fortify(model = x, showCategory = showCategory, 164 | includeAll = TRUE, split = split) 165 | y$Cluster <- sub("\n.*", "", y$Cluster) 166 | keep <- rownames(prepare_pie_category(y, pie=pie)) 167 | } else { 168 | n <- update_n(x, showCategory) 169 | if (is.numeric(n)) { 170 | keep <- seq_len(n) 171 | } else { 172 | keep <- match(n, rownames(x@termsim)) 173 | } 174 | } 175 | if (length(keep) == 0) { 176 | stop("no enriched term found...") 177 | } 178 | fill_termsim(x, keep) 179 | } 180 | 181 | 182 | 183 | ##' Adjust axis label according to the dimension reduction method 184 | ##' 185 | ##' @param p ggplot2 object 186 | ##' @param drs dimension reduction result 187 | ##' @noRd 188 | adj_axis <- function(p, drResult) { 189 | title = NULL 190 | eigenvalue <- drResult$eigenvalue 191 | if (!is.null(eigenvalue)) { 192 | xlab = paste("Dimension1 (", format(100 * eigenvalue[1] / sum(eigenvalue), digits=4), "%)", sep = "") 193 | ylab = paste("Dimension2 (", format(100 * eigenvalue[2] / sum(eigenvalue), digits=4), "%)", sep = "") 194 | } else { 195 | xlab = "Dimension1" 196 | ylab = "Dimension2" 197 | if (!is.null(drResult$stress)) { 198 | title = paste("stress = ", drResult$stress, sep = "") 199 | } 200 | } 201 | p <- p + labs(x = xlab, y = ylab, title = title) 202 | return(p) 203 | } 204 | 205 | ##' Get the result of dimension reduction 206 | ##' 207 | ##' @param x enrichment result. 208 | ##' @param showCategory number of enriched terms to display. 209 | ##' @param split separate result by 'category' variable. 210 | ##' @param pie proportion of clusters in the pie chart. 211 | ##' @param drfun The function used for dimension reduction. 212 | ##' @param dr.params list, the parameters of tidydr::dr. 213 | ##' @importFrom rlang check_installed 214 | ##' @noRd 215 | get_drResult <- function(x, showCategory, split = NULL, pie = NULL, drfun, dr.params) { 216 | distance_mat <- build_dist(x = x, showCategory = showCategory, split = split, pie = pie) 217 | check_installed('tidydr', 'for `get_drResult()`, which is an internal function.') 218 | drResult <- do.call(tidydr::dr, c(list(data = distance_mat, fun = drfun), dr.params)) 219 | wrongMessage <- paste("Wrong drfun parameter or unsupported", 220 | "dimensionality reduction method;", 221 | "set to default `drfun = 'stats::cmdscale'`") 222 | if (is.null(drResult$drdata)) { 223 | message(wrongMessage) 224 | drResult <- tidydr::dr(distance_mat, stats::cmdscale, eig = TRUE) 225 | } 226 | drResult 227 | } 228 | -------------------------------------------------------------------------------- /R/theme.R: -------------------------------------------------------------------------------- 1 | theme_dose <- DOSE::theme_dose 2 | -------------------------------------------------------------------------------- /R/upsetplot.R: -------------------------------------------------------------------------------- 1 | ##' upsetplot 2 | ##' 3 | ##' 4 | ##' @rdname upsetplot-methods 5 | ##' @aliases upsetplot,enrichResult,ANY-method 6 | ##' @param n number of categories to be plotted 7 | ##' @author Guangchuang Yu 8 | ##' @exportMethod upsetplot 9 | ##' @examples 10 | ##' require(DOSE) 11 | ##' data(geneList) 12 | ##' de=names(geneList)[1:100] 13 | ##' x <- enrichDO(de) 14 | ##' upsetplot(x, 8) 15 | setMethod("upsetplot", signature(x="enrichResult"), 16 | function(x, n=10, ...) { 17 | upsetplot.enrichResult(x, n, ...) 18 | }) 19 | 20 | ##' @rdname upsetplot-methods 21 | ##' @aliases upsetplot,gseaResult 22 | ##' @exportMethod upsetplot 23 | setMethod("upsetplot", signature(x="gseaResult"), 24 | function(x, n=10, ...) { 25 | upsetplot.gseaResult(x, n, ...) 26 | }) 27 | 28 | 29 | ##' @importFrom rlang check_installed 30 | upsetplot.enrichResult <- function(x, n=10, ...) { 31 | df <- as.data.frame(x) 32 | id <- df$ID[1:n] 33 | des <- df$Description[1:n] 34 | glist <- geneInCategory(x)[id] 35 | names(glist) <- des 36 | ## g <- unique(unlist(glist)) 37 | 38 | 39 | ## dat <- matrix(0, nrow=length(g), ncol=length(id)) 40 | ## rownames(dat) <- g 41 | ## for (i in 1:length(id)) { 42 | ## dat[glist[[i]], i] <- 1 43 | ## } 44 | ## colnames(dat) <- des 45 | 46 | ## ## cols <- ggtree:::color_scale("red", "blue") 47 | ## ## pv <- df$pvalue[1:n] 48 | ## ## idx <- sapply(pv, function(p) DOSE:::getIdx(p, min(pv), max(pv))) 49 | 50 | ## ## sets.bar.color = cols[idx], 51 | 52 | ## ## UpSetR <- "UpSetR" 53 | ## ## require(UpSetR, character.only = TRUE) 54 | ## ## upset <- eval(parse(text="upset")) 55 | 56 | ## upsetR::upset(as.data.frame(dat), nsets=n, ...) 57 | d <- list2df(glist) 58 | check_installed('tibble', 'for `upsetplot()`.') 59 | check_installed('ggupset', 'for `upsetplot()`.') 60 | res <- tibble::tibble(Description = split(d[,1], d[,2])) 61 | ggplot(res, aes_(x = ~Description)) + geom_bar() + 62 | theme_dose(font.size = 12) + 63 | xlab(NULL) + ylab(NULL) + 64 | ggupset::scale_x_upset(order_by = "freq") 65 | } 66 | 67 | ##' @importFrom ggplot2 geom_violin 68 | ##' @importFrom ggplot2 geom_jitter 69 | ##' @importFrom rlang check_installed 70 | upsetplot.gseaResult <- function(x, n = 10, type = "boxplot", ...) { 71 | n <- update_n(x, n) 72 | geneSets <- extract_geneSets(x, n) 73 | 74 | ## foldChange <- fc_readable(x, x@geneList) 75 | d <- list2df(geneSets) 76 | 77 | category <- split(d[,1], d[, 2]) 78 | check_installed('tibble', 'for `upsetplot()`.') 79 | y <- tibble::tibble(Description = category, 80 | gene = names(category), 81 | foldChange = x@geneList[names(category)]) 82 | 83 | if (type == "boxplot") { 84 | ly_dist <- geom_boxplot() 85 | } else { 86 | ly_dist <- geom_violin() 87 | } 88 | 89 | check_installed('ggupset', 'for `upsetplot()`.') 90 | ggplot(y, aes_(x = ~Description, y = ~foldChange)) + 91 | ly_dist + 92 | geom_jitter(width = .2, alpha = .6) + 93 | theme_dose(font.size = 12) + 94 | xlab(NULL) + ylab(NULL) + 95 | ggupset::scale_x_upset(order_by = "degree") 96 | } 97 | 98 | ## @rdname upsetplot-methods 99 | ## @aliases upsetplot,compareClusterResult 100 | ## @exportMethod upsetplot 101 | #setMethod("upsetplot", signature(x="compareClusterResult"), 102 | # function(x, n=10, ...) { 103 | # upsetplot.compareClusterResult(x, n, ...) 104 | # }) 105 | 106 | 107 | upsetplot.compareClusterResult <- function(x, n, ...) { 108 | x <- append_intersect(x) 109 | 110 | ## ggplot(x, aes(-10*log10(p.adjust), Description)) + geom_point() + facet_grid(set~., scales="free") 111 | 112 | ggplot(x, aes(.data$Cluster, .data$Description), showCategory=n) + 113 | geom_point(aes(size=-10*log10(.data$p.adjust), color=.data$Cluster)) + 114 | facet_grid(intersect ~ ., scales = "free", space = 'free') + guides(color = "none") + 115 | theme_dose(font.size = 12) + 116 | theme(strip.text = element_text(size = 14)) + 117 | xlab(NULL) + ylab(NULL) 118 | } 119 | 120 | -------------------------------------------------------------------------------- /R/utilities.R: -------------------------------------------------------------------------------- 1 | ##' automatically split barplot or dotplot into several facets 2 | ##' 3 | ##' 4 | ##' @param by one of 'row' or 'column' 5 | ##' @param scales wether 'fixed' or 'free' 6 | ##' @param levels set facet levels 7 | ##' @return a ggplot object 8 | ##' @export 9 | autofacet <- function(by = 'row', scales = "free", levels = NULL) { 10 | structure(list(by = by, 11 | scales = scales, 12 | levels = levels), 13 | class = "autofacet") 14 | } 15 | 16 | get_enrichplot_color <- function(n = 2) { 17 | colors <- getOption("enrichplot.colours") 18 | if (!is.null(colors)) return(colors) 19 | 20 | if (n != 2 && n != 3) stop("'n' should be 2 or 3") 21 | 22 | colors = c("#e06663", "#327eba") 23 | if (n == 2) return(colors) 24 | 25 | if (n == 3) return(c(colors[1], "white", colors[2])) 26 | } 27 | 28 | ##' helper function to set color for enrichplot 29 | ##' 30 | ##' 31 | ##' @title set_enrichplot_color 32 | ##' @param colors user provided color vector 33 | ##' @param type one of 'color', 'colour' or 'fill' 34 | ##' @param name name of the color legend 35 | ##' @param .fun force to use user provided color scale function 36 | ##' @param reverse whether reverse the color scheme, default is TRUE as it is more significant for lower pvalue 37 | ##' @param ... additional parameter that passed to the color scale function 38 | ##' @return a color scale 39 | ##' @importFrom ggplot2 scale_fill_continuous 40 | ##' @importFrom ggplot2 scale_color_continuous 41 | ##' @importFrom ggplot2 scale_fill_gradientn 42 | ##' @importFrom ggplot2 scale_color_gradientn 43 | ##' @export 44 | set_enrichplot_color <- function(colors = get_enrichplot_color(2), 45 | type = "color", name = NULL, .fun = NULL, reverse=TRUE, ...) { 46 | 47 | type <- match.arg(type, c("color", "colour", "fill")) 48 | if (!reverse) colors = rev(colors) 49 | n <- length(colors) 50 | if (n < 2) { 51 | stop("'colors' should be of length >= 2") 52 | } else if (n == 2) { 53 | params <- list(low = colors[1], high = colors[2]) 54 | fn_suffix <- "continuous" 55 | } else if (n == 3) { 56 | params <- list(low = colors[1], mid = colors[2], high = colors[3]) 57 | fn_suffix <- "gradient2" 58 | } else { 59 | params <- list(colors = colors) 60 | fn_suffix <- "gradientn" 61 | } 62 | 63 | if (!is.null(.fun)) { 64 | if (n == 3) { 65 | # should determine parameter for user selected functions: 'gradient2' or 'gradientn' 66 | fn_type <- which_scale_fun(.fun) 67 | if (fn_type == "gradientn") { 68 | params <- list(colors = colors) 69 | } else { 70 | params <- list(low = colors[1], mid = colors[2], high = colors[3]) 71 | } 72 | } 73 | } else { 74 | fn <- sprintf("scale_%s_%s", type, fn_suffix) 75 | .fun <- getFromNamespace(fn, "ggplot2") 76 | } 77 | 78 | params$guide <- guide_colorbar(reverse=reverse, order=1) 79 | params$name <- name # no legend name setting by default as 'name = NULL' 80 | 81 | params <- modifyList(params, list(...)) 82 | 83 | do.call(.fun, params) 84 | } 85 | 86 | 87 | which_scale_fun <- function(.fun) { 88 | params <- args(.fun) |> as.list() |> names() 89 | if ("colours" %in% params) { 90 | return("gradientn") 91 | } 92 | if ("mid" %in% params) { 93 | return("gradient2") 94 | } 95 | # maybe need to determine whether is continuous or discrete 96 | return("continuous") 97 | } 98 | 99 | ##' @method as.data.frame compareClusterResult 100 | ##' @export 101 | as.data.frame.compareClusterResult <- function(x, ...) { 102 | as.data.frame(x@compareClusterResult, ...) 103 | } 104 | 105 | 106 | ##' Prepare pie data for genes in cnetplot. 107 | ##' The function only works for compareClusterResult 108 | ##' 109 | ##' @importFrom DOSE geneID 110 | ##' @importFrom rlang check_installed 111 | ##' @param y a data.frame converted from compareClusterResult 112 | ##' @return a data.frame 113 | ##' @noRd 114 | prepare_pie_gene <- function(y) { 115 | check_installed('tibble', 'for `prepare_pie_gene()`.') 116 | gene_pie <- tibble::as_tibble(y[,c("Cluster", "Description", "geneID")]) 117 | gene_pie$geneID <- strsplit(gene_pie$geneID, '/') 118 | gene_pie2 <- as.data.frame(tidyr::unnest(gene_pie, cols=geneID)) 119 | gene_pie2 <- unique(gene_pie2) 120 | prepare_pie_data(gene_pie2, pie = "equal", type = "gene") 121 | } 122 | 123 | 124 | ##' Prepare pie data for categories in cnetplot/emapplot. 125 | ##' The function only works for compareClusterResult 126 | ##' 127 | ##' @param enrichDf a data.frame converted from compareClusterResult 128 | ##' @param pie proportion of clusters in the pie chart, one of 'equal' (default) 129 | ##' or 'Count' 130 | ##' @return a data.frame 131 | ##' @noRd 132 | prepare_pie_category <- function(enrichDf, pie = "equal") { 133 | pie <- match.arg(pie, c("equal", "count", "Count")) 134 | if (pie == "count") pie <- "Count" 135 | 136 | pie_data <- enrichDf[,c("Cluster", "Description", "Count")] 137 | pie_data[,"Description"] <- as.character(pie_data[,"Description"]) 138 | prepare_pie_data(pie_data, pie = pie) 139 | } 140 | 141 | 142 | 143 | 144 | prepare_pie_data <- function(pie_data, pie = "equal",type = "category") { 145 | if(type == "category"){ 146 | ID_unique <- unique(pie_data[,2]) 147 | } else { 148 | ID_unique <- unique(pie_data[,3]) 149 | } 150 | 151 | Cluster_unique <- unique(pie_data[,1]) 152 | ID_Cluster_mat <- matrix(0, nrow = length(ID_unique), ncol = length(Cluster_unique)) 153 | rownames(ID_Cluster_mat) <- ID_unique 154 | colnames(ID_Cluster_mat) <- Cluster_unique 155 | ID_Cluster_mat <- as.data.frame(ID_Cluster_mat, stringAsFactors = FALSE) 156 | if(pie == "Count") { 157 | for(i in seq_len(nrow(pie_data))) { 158 | ID_Cluster_mat[pie_data[i,2],pie_data[i,1]] <- pie_data[i,3] 159 | } 160 | for(kk in seq_len(ncol(ID_Cluster_mat))) { 161 | ID_Cluster_mat[,kk] <- as.numeric(ID_Cluster_mat[,kk]) 162 | } 163 | return(ID_Cluster_mat) 164 | } 165 | for(i in seq_len(nrow(pie_data))) { 166 | if(type == "category"){ 167 | ID_Cluster_mat[pie_data[i,2],pie_data[i,1]] <- 1 168 | } else { 169 | ID_Cluster_mat[pie_data[i,3],pie_data[i,1]] <- 1 170 | } 171 | 172 | } 173 | return(ID_Cluster_mat) 174 | } 175 | 176 | 177 | ##' create color palette for continuous data 178 | ##' 179 | ##' 180 | ##' @title color_palette 181 | ##' @param colors colors of length >=2 182 | ##' @return color vector 183 | ##' @importFrom rlang check_installed 184 | ##' @export 185 | ##' @examples 186 | ##' color_palette(c("red", "yellow", "green")) 187 | ##' @author guangchuang yu 188 | color_palette <- function(colors) { 189 | # has_package("grDevices") 190 | check_installed('grDevices', 'for `color_palette()`.') 191 | grDevices::colorRampPalette(colors)(n = 299) 192 | } 193 | 194 | enrichplot_point_shape <- ggfun:::enrichplot_point_shape 195 | 196 | sig_palette <- color_palette(c("red", "yellow", "blue")) 197 | 198 | heatmap_palette <- color_palette(c("red", "yellow", "green")) 199 | 200 | overlap_ratio <- function(x, y) { 201 | x <- unlist(x) 202 | y <- unlist(y) 203 | length(intersect(x, y))/length(unique(c(x,y))) 204 | } 205 | 206 | .cal_jc_similarity <- function(gsetlist, id = NULL, name=NULL){ 207 | if (is.null(id)) { 208 | id <- names(gsetlist) 209 | } 210 | n <- length(id) 211 | w <- matrix(NA, nrow=n, ncol=n) 212 | if (is.null(name)) { 213 | name <- id 214 | } 215 | colnames(w) <- rownames(w) <- name 216 | for (i in seq_len(n-1)) { 217 | for (j in (i+1):n) { 218 | w[i,j] <- overlap_ratio(gsetlist[id[i]], gsetlist[id[j]]) 219 | } 220 | } 221 | w[lower.tri(w)] <- t(w)[lower.tri(t(w))] 222 | diag(w) <- 1 223 | return(w) 224 | } 225 | 226 | fc_readable <- function(x, foldChange = NULL) { 227 | if (is.null(foldChange)) 228 | return(NULL) 229 | 230 | if (x@readable && x@keytype != "SYMBOL") { 231 | gid <- names(foldChange) 232 | if (is(x, 'gseaResult')) { 233 | ii <- gid %in% names(x@geneList) 234 | } else { 235 | ii <- gid %in% x@gene 236 | } 237 | gid[ii] <- x@gene2Symbol[gid[ii]] 238 | names(foldChange) <- gid 239 | } 240 | return(foldChange) 241 | } 242 | 243 | # fc_palette <- function(fc) { 244 | # if (all(fc > 0, na.rm=TRUE)) { 245 | # palette <- color_palette(c("blue", "red")) 246 | # } else if (all(fc < 0, na.rm=TRUE)) { 247 | # palette <- color_palette(c("green", "blue")) 248 | # } else { 249 | ## palette <- color_palette(c("darkgreen", "#0AFF34", "#B3B3B3", "#FF6347", "red")) 250 | # } 251 | # return(palette) 252 | # } 253 | 254 | update_n <- function(x, showCategory) { 255 | if (!is.numeric(showCategory)) { 256 | if (inherits(x, 'list')) { 257 | showCategory <- showCategory[showCategory %in% names(x)] 258 | } else { 259 | showCategory <- intersect(showCategory, x$Description) 260 | } 261 | return(showCategory) 262 | } 263 | 264 | ## geneSets <- geneInCategory(x) ## use core gene for gsea result 265 | n <- showCategory 266 | if (inherits(x, 'list')) { 267 | nn <- length(x) 268 | } else { 269 | nn <- nrow(x) 270 | } 271 | if (nn < n) { 272 | n <- nn 273 | } 274 | 275 | return(n) 276 | } 277 | 278 | extract_geneSets <- function(x, n) { 279 | n <- update_n(x, n) 280 | 281 | if (inherits(x, 'list')) { 282 | geneSets <- x 283 | } else { 284 | geneSets <- geneInCategory(x) ## use core gene for gsea result 285 | y <- as.data.frame(x) 286 | geneSets <- geneSets[y$ID] 287 | names(geneSets) <- y$Description 288 | } 289 | if (is.numeric(n)) { 290 | return(geneSets[1:n]) 291 | } 292 | return(geneSets[n]) ## if n is a vector of Description 293 | } 294 | 295 | ##' Internal plot function for plotting compareClusterResult 296 | ##' 297 | ##' 298 | ##' @title plotting-clusterProfile 299 | ##' @param clProf.reshape.df data frame of compareCluster result 300 | ##' @param x x variable 301 | ##' @param type one of dot and bar 302 | ##' @param by one of percentage and count 303 | ##' @param title graph title 304 | ##' @param font.size graph font size 305 | ##' @param colorBy one of pvalue or p.adjust 306 | ##' @return ggplot object 307 | ##' @importFrom ggplot2 ggplot 308 | ##' @importFrom ggplot2 aes 309 | ##' @importFrom ggplot2 aes_ 310 | ##' @importFrom ggplot2 aes_string 311 | ##' @importFrom ggplot2 geom_bar 312 | ##' @importFrom ggplot2 coord_flip 313 | ##' @importFrom ggplot2 geom_point 314 | ##' @importFrom ggplot2 %+% 315 | ##' @importFrom ggplot2 theme 316 | ##' @importFrom ggplot2 xlab 317 | ##' @importFrom ggplot2 ylab 318 | ##' @importFrom ggplot2 theme_bw 319 | ##' @importFrom ggplot2 element_text 320 | ##' @importFrom ggplot2 ggtitle 321 | ##' @importFrom ggplot2 scale_color_continuous 322 | ##' @importFrom ggplot2 guide_colorbar 323 | ##' @importFrom DOSE theme_dose 324 | ##' @author Guangchuang Yu \url{https://yulab-smu.top} 325 | plotting.clusterProfile <- function(clProf.reshape.df, 326 | x = ~Cluster, 327 | type = "dot", 328 | colorBy = "p.adjust", 329 | by = "geneRatio", 330 | title="", 331 | font.size=12) { 332 | Description <- Percentage <- Count <- Cluster <- GeneRatio <- p.adjust <- pvalue <- NULL # to satisfy codetools 333 | if (type == "bar") { 334 | if (by == "percentage") { 335 | p <- ggplot(clProf.reshape.df, 336 | aes(x=Description, y = Percentage, fill=Cluster)) 337 | } else if (by == "count") { 338 | p <- ggplot(clProf.reshape.df, 339 | aes(x=Description, y = Count, fill=Cluster)) 340 | } else { 341 | 342 | } 343 | p <- p + 344 | geom_bar() + 345 | coord_flip() 346 | } 347 | 348 | p <- p + xlab("") + ylab("") + ggtitle(title) + 349 | theme_dose(font.size) 350 | return(p) 351 | } 352 | 353 | 354 | 355 | 356 | ##' Get the distance of the label 357 | ##' 358 | ##' @param dimension one of 1 and 2 359 | ##' @param label_location label_location 360 | ##' @noRd 361 | get_label_diss <- function(dimension, label_location) { 362 | nn <- nrow(label_location) 363 | label_dis <- matrix(NA, nrow = nn, ncol = nn) 364 | colnames(label_dis) <- rownames(label_dis) <- label_location$label 365 | for (i in seq_len(nn - 1)) { 366 | for (j in (i + 1):nn) { 367 | label_dis[i ,j] <- label_location[i, dimension] - label_location[j, dimension] 368 | } 369 | } 370 | label_diss <- reshape2::melt(label_dis) 371 | label_diss <- label_diss[label_diss[,1] != label_diss[,2], ] 372 | label_diss <- label_diss[!is.na(label_diss[,3]), ] 373 | label_diss[, 1] <- as.character(label_diss[, 1]) 374 | label_diss[, 2] <- as.character(label_diss[, 2]) 375 | return(label_diss) 376 | } 377 | 378 | 379 | 380 | # adjust_location <- function(label_location, x_adjust, y_adjust) { 381 | # label_diss_x <- get_label_diss(1, label_location) 382 | # label_diss_y <- get_label_diss(2, label_location) 383 | 384 | # label_diss_large <- which(abs(label_diss_y[, 3]) < y_adjust) %>% 385 | # intersect(which(label_diss_y[, 3] > 0)) %>% 386 | # intersect(which(abs(label_diss_x[, 3]) < x_adjust)) 387 | 388 | # label_diss_small <- which(abs(label_diss_y[, 3]) < y_adjust) %>% 389 | # intersect(which(label_diss_y[, 3] < 0)) %>% 390 | # intersect(which(abs(label_diss_x[, 3]) < x_adjust)) 391 | 392 | # label_location[label_diss_y[label_diss_large, 1], 2] <- label_location[label_diss_y[label_diss_large, 2], 2] + y_adjust 393 | # label_location[label_diss_y[label_diss_small, 1], 2] <- label_location[label_diss_y[label_diss_small, 2], 2] - y_adjust 394 | # return(label_location) 395 | # } 396 | 397 | 398 | 399 | #' default_labeller 400 | #' 401 | #' default labeling function that uses the 402 | #' internal string wrapping function `yulab.utils::str_wrap` 403 | #' @noRd 404 | #' @importFrom yulab.utils str_wrap 405 | default_labeller <- function(n) { 406 | fun <- function(str){ 407 | str <- gsub("_", " ", str) 408 | yulab.utils::str_wrap(str, n) 409 | } 410 | 411 | structure(fun, class = "labeller") 412 | } 413 | 414 | # from hadley wickham in "https://r.789695.n4.nabble.com/Suppressing-output-e-g-from-cat-td859876.html" 415 | #' Suppressing output 416 | #' 417 | #' @param x some code 418 | #' @noRd 419 | quiet <- function(x) { 420 | sink(tempfile()) 421 | on.exit(sink()) 422 | invisible(force(x)) 423 | } 424 | 425 | 426 | #' Get segment.size value for ggrepel 427 | #' @param default default value of ggrepel.segment.size 428 | #' @noRd 429 | get_ggrepel_segsize <- function(default = 0.2) { 430 | getOption("ggrepel.segment.size", default = default) 431 | } 432 | 433 | #' Get warning message of changing parameter name 434 | #' @param parameter old parameter name 435 | #' @param params_df data frame with three columns: "original", "listname", and "present" 436 | #' @noRd 437 | get_param_change_message <- function(parameter, params_df) { 438 | paste0("Use '", params_df[parameter, "listname"], 439 | " = list(", params_df[parameter, "present"], 440 | " = your_value)' instead of '", params_df[parameter, "original"], 441 | "'.\n The ", params_df[parameter, "original"], 442 | " parameter will be removed in the next version.") 443 | } 444 | -------------------------------------------------------------------------------- /R/volplot.R: -------------------------------------------------------------------------------- 1 | ##' @rdname volplot 2 | ##' @exportMethod volplot 3 | ##' @author Guangchuang Yu 4 | setMethod("volplot", signature(x = "enrichResult"), 5 | function(x, color = "zScore", 6 | xintercept = 1, yintercept = 2, 7 | showCategory = 5, label_format = 30, 8 | ...) { 9 | volplot.enrichResult(x = x, color = color, 10 | xintercept = xintercept, yintercept = yintercept, 11 | showCategory = showCategory, label_format = label_format, 12 | ...) 13 | }) 14 | 15 | ##' @rdname volplot 16 | ##' @param font.size font size for `theme_dose()` 17 | ##' @param size font size to label selected categories specified by showCategory 18 | volplot.enrichResult <- function(x, color = "zScore", 19 | xintercept = 1, yintercept = 2, 20 | showCategory=5, label_format = 30, 21 | font.size=12, size = 5) { 22 | 23 | if (yintercept < 1) yintercept = -log10(yintercept) 24 | 25 | p <- ggplot(x@result, aes(x=log2(.data$FoldEnrichment), y= -log10(.data$p.adjust))) + 26 | geom_point(aes(color=.data[[color]])) + 27 | geom_hline(yintercept = yintercept, lty='dashed') + 28 | geom_vline(xintercept = xintercept, lty='dashed') 29 | 30 | p <- p + set_enrichplot_color(type = "color", reverse = FALSE) + 31 | theme_dose(font.size) 32 | 33 | if (is.numeric(showCategory)) { 34 | topN <- showCategory 35 | d <- dplyr::arrange(x@result, dplyr::desc(.data[[color]])) 36 | showCategory <- d$Description[1:topN] 37 | } 38 | 39 | label_func <- .label_format(label_format) 40 | p <- p + ggrepel::geom_text_repel(aes(label=label_func(.data$Description)), 41 | data = function(d) dplyr::filter(d, .data$Description %in% showCategory), 42 | size = size 43 | ) 44 | 45 | p <- p + labs(x=bquote(paste(log[2], "(FoldEnrichment)")), 46 | y = bquote(paste(-log[10], "(p.adjust)")) 47 | ) 48 | 49 | return(p) 50 | } -------------------------------------------------------------------------------- /R/wordcloud.R: -------------------------------------------------------------------------------- 1 | ##' Get the frequency of each word in a vector of terms. 2 | ##' 3 | ##' @param wordd clusters, a vector of terms. 4 | ##' @noRd 5 | get_word_freq <- function(wordd){ 6 | dada <- strsplit(wordd, " ") 7 | didi <- table(unlist(dada)) 8 | didi <- didi[order(didi, decreasing = TRUE)] 9 | # Get the number of each word 10 | word_name <- names(didi) 11 | fun_num_w <- function(ww){ 12 | sum(vapply(dada, function(w){ww %in% w}, FUN.VALUE = 1)) 13 | } 14 | word_num <- vapply(word_name, fun_num_w, FUN.VALUE = 1) 15 | word_w <- word_num[order(word_num, decreasing = TRUE)] 16 | } 17 | 18 | ##' Use wordcloud algorithm to get group tags 19 | ##' 20 | ##' @param cluster a cluster name 21 | ##' @param ggData the data section of the ggraph object, 22 | ##' which contains clustering information. 23 | ##' @param nWords the number of words in the cluster tags 24 | ##' @importFrom magrittr %>% 25 | ##' @noRd 26 | get_wordcloud <- function(cluster, ggData, nWords){ 27 | words <- ggData$name %>% 28 | gsub(" in ", " ", .) %>% 29 | gsub(" [0-9]+ ", " ", .) %>% 30 | gsub("^[0-9]+ ", "", .) %>% 31 | gsub(" [0-9]+$", "", .) %>% 32 | gsub(" [A-Za-z] ", " ", .) %>% 33 | gsub("^[A-Za-z] ", "", .) %>% 34 | gsub(" [A-Za-z]$", "", .) %>% 35 | gsub(" / ", " ", .) %>% 36 | gsub(" and ", " ", .) %>% 37 | gsub(" of ", " ", .) %>% 38 | gsub(",", " ", .) %>% 39 | gsub(" - ", " ", .) 40 | net_tot <- length(words) 41 | 42 | clusters <- unique(ggData$color2) 43 | words_i <- words[which(ggData$color2 == cluster)] 44 | 45 | sel_tot <- length(words_i) 46 | sel_w <- get_word_freq(words_i) 47 | net_w_all <- get_word_freq(words) 48 | net_w <- net_w_all[names(sel_w)] 49 | tag_size <- (sel_w/sel_tot)/(net_w/net_tot) 50 | tag_size <- tag_size[order(tag_size, decreasing = TRUE)] 51 | nWords <- min(nWords, length(tag_size)) 52 | tag <- names(tag_size[seq_len(nWords)]) 53 | 54 | # Order of words 55 | dada <- strsplit(words_i, " ") 56 | len <- vapply(dada, length, FUN.VALUE=1) 57 | rank <- NULL 58 | for(i in seq_len(sel_tot)) { 59 | rank <- c(rank, seq_len(len[i])) 60 | } 61 | 62 | word_data <- data.frame(word = unlist(dada), rank = rank) 63 | word_rank1 <- stats::aggregate(rank ~ word, data = word_data, sum) 64 | rownames(word_rank1) <- word_rank1[, 1] 65 | 66 | word_rank1 <- word_rank1[names(sel_w), ] 67 | # Get an average ranking order 68 | word_rank1[, 2] <- word_rank1[, 2]/as.numeric(sel_w) 69 | tag_order <- word_rank1[tag, ] 70 | tag_order <- tag_order[order(tag_order[, 2]), ] 71 | tag_clu_i <- paste(tag_order$word, collapse=" ") 72 | } 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | ##' @importFrom yulab.utils yulab_msg 2 | .onAttach <- function(libname, pkgname) { 3 | options(check.tbl_tree.verbose = FALSE) 4 | packageStartupMessage(yulab_msg(pkgname)) 5 | } 6 | 7 | 8 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | md_document: 4 | variant: gfm 5 | html_preview: false 6 | --- 7 | 8 | 9 | 10 | 11 | # `r ypages:::packageTitle('enrichplot', 'BioC')` 12 | 13 | ```{r echo=FALSE, results="hide", message=FALSE} 14 | library("badger") 15 | library("ypages") 16 | ``` 17 | 18 | 19 | 20 | `r badge_bioc_release("enrichplot", "green")` 21 | `r badge_devel("guangchuangyu/enrichplot", "green")` 22 | [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/enrichplot.svg)](https://www.bioconductor.org/packages/devel/bioc/html/enrichplot.html#since) 23 | 24 | `r badge_download_bioc("enrichplot")` 25 | `r badge_bioc_download("enrichplot", "total", "blue")` 26 | `r badge_bioc_download("enrichplot", "month", "blue")` 27 | 28 | 29 | [![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) 30 | [![platform](http://www.bioconductor.org/shields/availability/devel/enrichplot.svg)](https://www.bioconductor.org/packages/devel/bioc/html/enrichplot.html#archives) 31 | [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/treeio.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/treeio/) 32 | [![Last-changedate](https://img.shields.io/badge/last%20change-`r gsub('-', '--', Sys.Date())`-green.svg)](https://github.com/GuangchuangYu/treeio/commits/master) 33 | 34 | 35 | ```{r comment="", echo=FALSE, results='asis'} 36 | cat(packageDescription('enrichplot')$Description) 37 | ``` 38 | 39 | 40 | For details, please visit . 41 | 42 | 43 | ## :writing_hand: Authors 44 | 45 | 46 | Guangchuang YU 47 | 48 | 49 | School of Basic Medical Sciences, Southern Medical University 50 | 51 | [![Twitter](https://img.shields.io/twitter/url/http/shields.io.svg?style=social&logo=twitter)](https://twitter.com/intent/tweet?hashtags=enrichplot) 52 | [![saythanks](https://img.shields.io/badge/say-thanks-ff69b4.svg)](https://saythanks.io/to/GuangchuangYu) 53 | `r badger::badge_custom('follow me on', 'WeChat', 'green', 'https://guangchuangyu.github.io/blog_images/biobabble.jpg')` 54 | 55 | 56 | ## :arrow_double_down: Installation 57 | 58 | 59 | Get the released version from Bioconductor: 60 | 61 | ```r 62 | ## try http:// if https:// URLs are not supported 63 | if (!requireNamespace("BiocManager", quietly=TRUE)) 64 | install.packages("BiocManager") 65 | ## BiocManager::install("BiocUpgrade") ## you may need this 66 | BiocManager::install("enrichplot") 67 | ``` 68 | 69 | Or the development version from github: 70 | 71 | ```r 72 | ## install.packages("devtools") 73 | devtools::install_github("YuLab-SMU/enrichplot") 74 | ``` 75 | 76 | 77 | ## :sparkling_heart: Contributing 78 | 79 | We welcome any contributions! By participating in this project you agree to 80 | abide by the terms outlined in the [Contributor Code of Conduct](CONDUCT.md). 81 | 82 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | Visualization of Functional Enrichment Result 4 | ============================================= 5 | 6 | [![](https://img.shields.io/badge/release%20version-1.10.1-green.svg)](https://www.bioconductor.org/packages/enrichplot) 7 | [![](https://img.shields.io/badge/devel%20version-1.11.2-green.svg)](https://github.com/guangchuangyu/enrichplot) 8 | [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/enrichplot.svg)](https://www.bioconductor.org/packages/devel/bioc/html/enrichplot.html#since) 9 | 10 | [![download](http://www.bioconductor.org/shields/downloads/release/enrichplot.svg)](https://bioconductor.org/packages/stats/bioc/enrichplot) 11 | [![](https://img.shields.io/badge/download-163819/total-blue.svg)](https://bioconductor.org/packages/stats/bioc/enrichplot) 12 | [![](https://img.shields.io/badge/download-7883/month-blue.svg)](https://bioconductor.org/packages/stats/bioc/enrichplot) 13 | 14 | [![Project Status: Active - The project has reached a stable, usable 15 | state and is being actively 16 | developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) 17 | [![platform](http://www.bioconductor.org/shields/availability/devel/enrichplot.svg)](https://www.bioconductor.org/packages/devel/bioc/html/enrichplot.html#archives) 18 | [![Build 19 | Status](http://www.bioconductor.org/shields/build/devel/bioc/treeio.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/treeio/) 20 | [![Last-changedate](https://img.shields.io/badge/last%20change-2021--01--08-green.svg)](https://github.com/GuangchuangYu/treeio/commits/master) 21 | 22 | The ‘enrichplot’ package implements several visualization methods for 23 | interpreting functional enrichment results obtained from ORA or GSEA 24 | analysis. All the visualization methods are developed based on ‘ggplot2’ 25 | graphics. 26 | 27 | For details, please visit 28 | https://yulab-smu.top/biomedical-knowledge-mining-book/. 29 | 30 | :writing\_hand: Authors 31 | ----------------------- 32 | 33 | Guangchuang YU 34 | https://guangchuangyu.github.io 35 | 36 | School of Basic Medical Sciences, Southern Medical University 37 | 38 | [![Twitter](https://img.shields.io/twitter/url/http/shields.io.svg?style=social&logo=twitter)](https://twitter.com/intent/tweet?hashtags=enrichplot) 39 | [![saythanks](https://img.shields.io/badge/say-thanks-ff69b4.svg)](https://saythanks.io/to/GuangchuangYu) 40 | [![](https://img.shields.io/badge/follow%20me%20on-WeChat-green.svg)](https://guangchuangyu.github.io/blog_images/biobabble.jpg) 41 | 42 | :arrow\_double\_down: Installation 43 | ---------------------------------- 44 | 45 | Get the released version from Bioconductor: 46 | 47 | ## try http:// if https:// URLs are not supported 48 | if (!requireNamespace("BiocManager", quietly=TRUE)) 49 | install.packages("BiocManager") 50 | ## BiocManager::install("BiocUpgrade") ## you may need this 51 | BiocManager::install("enrichplot") 52 | 53 | Or the development version from github: 54 | 55 | ## install.packages("devtools") 56 | devtools::install_github("YuLab-SMU/enrichplot") 57 | 58 | :sparkling\_heart: Contributing 59 | ------------------------------- 60 | 61 | We welcome any contributions! By participating in this project you agree 62 | to abide by the terms outlined in the [Contributor Code of 63 | Conduct](CONDUCT.md). 64 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | # TODO LIST 2 | 3 | + [ ] manhattan plot for enriched result 4 | - figure 1 of 5 | + [ ] Circos plot for expression prifile and pathway annotation 6 | - Fig 2 of 7 | - maybe a cartisian coordination version, i.e. a heatmap with a dot table to indicate the pathways belong. 8 | + [ ] plot enriched terms as a tree 9 | - hc(1-sim), where sim is calculated by GOSemSim, and visualize by ggtree 10 | - label clade with representative words 11 | + [ ] plot gene expression profile by PCA (or other methods) and label clusters with representative words 12 | -------------------------------------------------------------------------------- /enrichplot.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 4 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/autofacet.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{autofacet} 4 | \alias{autofacet} 5 | \title{automatically split barplot or dotplot into several facets} 6 | \usage{ 7 | autofacet(by = "row", scales = "free", levels = NULL) 8 | } 9 | \arguments{ 10 | \item{by}{one of 'row' or 'column'} 11 | 12 | \item{scales}{wether 'fixed' or 'free'} 13 | 14 | \item{levels}{set facet levels} 15 | } 16 | \value{ 17 | a ggplot object 18 | } 19 | \description{ 20 | automatically split barplot or dotplot into several facets 21 | } 22 | -------------------------------------------------------------------------------- /man/barplot.enrichResult.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/barplot.R 3 | \name{barplot.enrichResult} 4 | \alias{barplot.enrichResult} 5 | \title{barplot} 6 | \usage{ 7 | \method{barplot}{enrichResult}( 8 | height, 9 | x = "Count", 10 | color = "p.adjust", 11 | showCategory = 8, 12 | font.size = 12, 13 | title = "", 14 | label_format = 30, 15 | ... 16 | ) 17 | } 18 | \arguments{ 19 | \item{height}{enrichResult object} 20 | 21 | \item{x}{one of 'Count' and 'GeneRatio'} 22 | 23 | \item{color}{one of 'pvalue', 'p.adjust' and 'qvalue'} 24 | 25 | \item{showCategory}{number of categories to show} 26 | 27 | \item{font.size}{font size} 28 | 29 | \item{title}{plot title} 30 | 31 | \item{label_format}{a numeric value sets wrap length, alternatively a 32 | custom function to format axis labels. 33 | by default wraps names longer that 30 characters} 34 | 35 | \item{...}{other parameter, ignored} 36 | } 37 | \value{ 38 | ggplot object 39 | } 40 | \description{ 41 | barplot of enrichResult 42 | } 43 | \examples{ 44 | library(DOSE) 45 | data(geneList) 46 | de <- names(geneList)[1:100] 47 | x <- enrichDO(de) 48 | barplot(x) 49 | # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. 50 | barplot(x, showCategory = 10) 51 | categorys <- c("urinary bladder cancer", "bronchiolitis obliterans", 52 | "aortic aneurysm", "esophageal cancer") 53 | barplot(x, showCategory = categorys) 54 | } 55 | -------------------------------------------------------------------------------- /man/cnetplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cnetplot.R 3 | \name{cnetplot.enrichResult} 4 | \alias{cnetplot.enrichResult} 5 | \alias{cnetplot.gseaResult} 6 | \alias{cnetplot.compareClusterResult} 7 | \title{cnetplot} 8 | \usage{ 9 | \method{cnetplot}{enrichResult}( 10 | x, 11 | layout = igraph::layout_with_kk, 12 | showCategory = 5, 13 | color_category = "#E5C494", 14 | size_category = 1, 15 | color_item = "#B3B3B3", 16 | size_item = 1, 17 | color_edge = "grey", 18 | size_edge = 0.5, 19 | node_label = "all", 20 | foldChange = NULL, 21 | hilight = "none", 22 | hilight_alpha = 0.3, 23 | ... 24 | ) 25 | 26 | \method{cnetplot}{gseaResult}( 27 | x, 28 | layout = igraph::layout_with_kk, 29 | showCategory = 5, 30 | color_category = "#E5C494", 31 | size_category = 1, 32 | color_item = "#B3B3B3", 33 | size_item = 1, 34 | color_edge = "grey", 35 | size_edge = 0.5, 36 | node_label = "all", 37 | foldChange = NULL, 38 | hilight = "none", 39 | hilight_alpha = 0.3, 40 | ... 41 | ) 42 | 43 | \method{cnetplot}{compareClusterResult}( 44 | x, 45 | layout = igraph::layout_with_kk, 46 | showCategory = 5, 47 | color_category = "#E5C494", 48 | size_category = 1, 49 | color_item = "#B3B3B3", 50 | size_item = 1, 51 | color_edge = "grey", 52 | size_edge = 0.5, 53 | node_label = "all", 54 | foldChange = NULL, 55 | hilight = "none", 56 | hilight_alpha = 0.3, 57 | pie = "equal", 58 | ... 59 | ) 60 | } 61 | \arguments{ 62 | \item{x}{input object} 63 | 64 | \item{layout}{network layout} 65 | 66 | \item{showCategory}{selected category to be displayed} 67 | 68 | \item{color_category}{color of category node} 69 | 70 | \item{size_category}{relative size of the category} 71 | 72 | \item{color_item}{color of item node} 73 | 74 | \item{size_item}{relative size of the item (e.g., genes)} 75 | 76 | \item{color_edge}{color of edge} 77 | 78 | \item{size_edge}{relative size of edge} 79 | 80 | \item{node_label}{one of 'all', 'none', 'category', 'item', 'exclusive' or 'share'} 81 | 82 | \item{foldChange}{numeric values to color the item (e.g, foldChange of gene expression values)} 83 | 84 | \item{hilight}{selected category to be highlighted} 85 | 86 | \item{hilight_alpha}{transparent value for not selected to be highlight} 87 | 88 | \item{...}{additional parameters} 89 | 90 | \item{pie}{one of 'equal' or 'Count' to set the slice ratio of the pies} 91 | } 92 | \description{ 93 | category-gene-network plot 94 | } 95 | \seealso{ 96 | [cnetplot][ggtangle::cnetplot] 97 | } 98 | -------------------------------------------------------------------------------- /man/color_palette.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{color_palette} 4 | \alias{color_palette} 5 | \title{color_palette} 6 | \usage{ 7 | color_palette(colors) 8 | } 9 | \arguments{ 10 | \item{colors}{colors of length >=2} 11 | } 12 | \value{ 13 | color vector 14 | } 15 | \description{ 16 | create color palette for continuous data 17 | } 18 | \examples{ 19 | color_palette(c("red", "yellow", "green")) 20 | } 21 | \author{ 22 | guangchuang yu 23 | } 24 | -------------------------------------------------------------------------------- /man/dotplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/dotplot.R 3 | \name{dotplot} 4 | \alias{dotplot} 5 | \alias{dotplot,enrichResult-method} 6 | \alias{dotplot,gseaResult-method} 7 | \alias{dotplot,compareClusterResult-method} 8 | \alias{dotplot,compareClusterResult,ANY-method} 9 | \alias{dotplot,enrichResultList-method} 10 | \alias{dotplot,enrichResultList,ANY-method} 11 | \alias{dotplot,gseaResultList-method} 12 | \alias{dotplot,gseaResultList,ANY-method} 13 | \alias{dotplot.enrichResult} 14 | \alias{dotplot.compareClusterResult} 15 | \title{dotplot} 16 | \usage{ 17 | dotplot(object, ...) 18 | 19 | \S4method{dotplot}{enrichResult}( 20 | object, 21 | x = "GeneRatio", 22 | color = "p.adjust", 23 | showCategory = 10, 24 | size = NULL, 25 | split = NULL, 26 | font.size = 12, 27 | title = "", 28 | orderBy = "x", 29 | label_format = 30, 30 | ... 31 | ) 32 | 33 | \S4method{dotplot}{gseaResult}( 34 | object, 35 | x = "GeneRatio", 36 | color = "p.adjust", 37 | showCategory = 10, 38 | size = NULL, 39 | split = NULL, 40 | font.size = 12, 41 | title = "", 42 | orderBy = "x", 43 | label_format = 30, 44 | ... 45 | ) 46 | 47 | \S4method{dotplot}{compareClusterResult}( 48 | object, 49 | x = "Cluster", 50 | color = "p.adjust", 51 | showCategory = 5, 52 | split = NULL, 53 | font.size = 12, 54 | title = "", 55 | by = "geneRatio", 56 | size = NULL, 57 | includeAll = TRUE, 58 | label_format = 30, 59 | ... 60 | ) 61 | 62 | \S4method{dotplot}{enrichResultList}( 63 | object, 64 | x = "GeneRatio", 65 | color = "p.adjust", 66 | showCategory = 10, 67 | size = NULL, 68 | split = NULL, 69 | font.size = 12, 70 | title = "", 71 | orderBy = "x", 72 | label_format = 30, 73 | ... 74 | ) 75 | 76 | \S4method{dotplot}{gseaResultList}( 77 | object, 78 | x = "GeneRatio", 79 | color = "p.adjust", 80 | showCategory = 10, 81 | size = NULL, 82 | split = NULL, 83 | font.size = 12, 84 | title = "", 85 | orderBy = "x", 86 | label_format = 30, 87 | ... 88 | ) 89 | 90 | dotplot.enrichResult( 91 | object, 92 | x = "geneRatio", 93 | color = "p.adjust", 94 | showCategory = 10, 95 | size = NULL, 96 | split = NULL, 97 | font.size = 12, 98 | title = "", 99 | orderBy = "x", 100 | label_format = 30, 101 | decreasing = TRUE 102 | ) 103 | 104 | dotplot.compareClusterResult( 105 | object, 106 | x = "Cluster", 107 | colorBy = "p.adjust", 108 | showCategory = 5, 109 | by = "geneRatio", 110 | size = "geneRatio", 111 | split = NULL, 112 | includeAll = TRUE, 113 | font.size = 12, 114 | title = "", 115 | label_format = 30, 116 | group = FALSE, 117 | shape = FALSE, 118 | facet = NULL, 119 | strip_width = 15 120 | ) 121 | } 122 | \arguments{ 123 | \item{object}{compareClusterResult object} 124 | 125 | \item{...}{additional parameters} 126 | 127 | \item{x}{variable for x-axis, one of 'GeneRatio' and 'Count'} 128 | 129 | \item{color}{variable that used to color enriched terms, 130 | e.g. 'pvalue', 'p.adjust' or 'qvalue'} 131 | 132 | \item{showCategory}{A number or a list of terms. If it is a number, 133 | the first n terms will be displayed. If it is a list of terms, 134 | the selected terms will be displayed.} 135 | 136 | \item{size}{variable that used to scale the sizes of categories, 137 | one of "geneRatio", "Percentage" and "count"} 138 | 139 | \item{split}{apply `showCategory` to each category specified by the 'split', e.g., "ONTOLOGY", "category" and "intersect". Default is NULL and do nothing} 140 | 141 | \item{font.size}{font size} 142 | 143 | \item{title}{figure title} 144 | 145 | \item{orderBy}{The order of the Y-axis} 146 | 147 | \item{label_format}{a numeric value sets wrap length, alternatively a 148 | custom function to format axis labels. 149 | by default wraps names longer that 30 characters} 150 | 151 | \item{by}{one of "geneRatio", "Percentage" and "count"} 152 | 153 | \item{includeAll}{logical} 154 | 155 | \item{decreasing}{logical. Should the orderBy order be increasing or decreasing?} 156 | 157 | \item{colorBy}{variable that used to color enriched terms, 158 | e.g. 'pvalue', 'p.adjust' or 'qvalue'} 159 | 160 | \item{group}{a logical value, whether to connect the 161 | nodes of the same group with wires.} 162 | 163 | \item{shape}{a logical value, whether to use nodes of 164 | different shapes to distinguish the group it belongs to} 165 | 166 | \item{facet}{apply `facet_grid` to the plot by specified variable, e.g., "ONTOLOGY", "category" and "intersect".} 167 | 168 | \item{strip_width}{width of strip text, a.k.a facet label.} 169 | } 170 | \value{ 171 | plot 172 | } 173 | \description{ 174 | dotplot for enrichment result 175 | } 176 | \examples{ 177 | \dontrun{ 178 | library(DOSE) 179 | data(geneList) 180 | de <- names(geneList)[1:100] 181 | x <- enrichDO(de) 182 | dotplot(x) 183 | # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. 184 | dotplot(x, showCategory = 10) 185 | categorys <- c("pre-malignant neoplasm", "intestinal disease", 186 | "breast ductal carcinoma", "non-small cell lung carcinoma") 187 | dotplot(x, showCategory = categorys) 188 | # It can also graph compareClusterResult 189 | data(gcSample) 190 | library(clusterProfiler) 191 | library(DOSE) 192 | library(org.Hs.eg.db) 193 | data(gcSample) 194 | xx <- compareCluster(gcSample, fun="enrichGO", OrgDb="org.Hs.eg.db") 195 | xx2 <- pairwise_termsim(xx) 196 | library(ggstar) 197 | dotplot(xx2) 198 | dotplot(xx2, shape = TRUE) 199 | dotplot(xx2, group = TRUE) 200 | dotplot(xx2, x = "GeneRatio", group = TRUE, size = "count") 201 | } 202 | } 203 | \author{ 204 | Guangchuang Yu 205 | } 206 | -------------------------------------------------------------------------------- /man/dotplot2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dotplot.R 3 | \name{dotplot2} 4 | \alias{dotplot2} 5 | \title{dotplot2} 6 | \usage{ 7 | dotplot2(object, x = "FoldEnrichment", vars = NULL, label = "auto", ...) 8 | } 9 | \arguments{ 10 | \item{object}{a compareClusterResult object} 11 | 12 | \item{x}{selected variable to visualize in x-axis} 13 | 14 | \item{vars}{selected Clusters to be compared, only length of two is supported} 15 | 16 | \item{label}{to label the Clusters in the plot, should be a named vector} 17 | 18 | \item{...}{additional parameters passed to dotplot} 19 | } 20 | \value{ 21 | a ggplot object 22 | } 23 | \description{ 24 | compare two clusters in the compareClusterResult object 25 | } 26 | \author{ 27 | Guangchuang Yu 28 | } 29 | -------------------------------------------------------------------------------- /man/emapplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/emapplot.R 3 | \name{emapplot} 4 | \alias{emapplot} 5 | \alias{emapplot,enrichResult-method} 6 | \alias{emapplot,gseaResult-method} 7 | \alias{emapplot,compareClusterResult-method} 8 | \alias{emapplot_internal} 9 | \title{emapplot} 10 | \usage{ 11 | emapplot(x, ...) 12 | 13 | \S4method{emapplot}{enrichResult}(x, showCategory = 30, ...) 14 | 15 | \S4method{emapplot}{gseaResult}(x, showCategory = 30, ...) 16 | 17 | \S4method{emapplot}{compareClusterResult}(x, showCategory = 30, ...) 18 | 19 | emapplot_internal( 20 | x, 21 | layout = igraph::layout_with_kk, 22 | showCategory = 30, 23 | color = "p.adjust", 24 | size_category = 1, 25 | min_edge = 0.2, 26 | color_edge = "grey", 27 | size_edge = 0.5, 28 | node_label = "category", 29 | pie = "equal", 30 | group = FALSE, 31 | group_style = "ggforce", 32 | label_group_style = "shawdowtext", 33 | label_format = 30, 34 | clusterFunction = stats::kmeans, 35 | nWords = 4, 36 | nCluster = NULL 37 | ) 38 | } 39 | \arguments{ 40 | \item{x}{Enrichment result.} 41 | 42 | \item{...}{Additional parameters} 43 | 44 | \item{showCategory}{A number or a vector of terms. If it is a number, 45 | the first n terms will be displayed. If it is a vector of terms, 46 | the selected terms will be displayed.} 47 | 48 | \item{layout}{igraph layout} 49 | 50 | \item{color}{Variable that used to color enriched terms, e.g. 'pvalue', 51 | 'p.adjust' or 'qvalue'.} 52 | 53 | \item{size_category}{relative size of the categories} 54 | 55 | \item{min_edge}{The minimum similarity threshold for whether 56 | two nodes are connected, should between 0 and 1, default value is 0.2.} 57 | 58 | \item{color_edge}{color of the network edge} 59 | 60 | \item{size_edge}{relative size of edge width} 61 | 62 | \item{node_label}{Select which labels to be displayed, 63 | one of 'category', 'group', 'all' and 'none'.} 64 | 65 | \item{pie}{one of 'equal' or 'Count' to set the slice ratio of the pies} 66 | 67 | \item{group}{logical, if TRUE, group the category.} 68 | 69 | \item{group_style}{style of ellipse, one of "ggforce" an "polygon".} 70 | 71 | \item{label_group_style}{style of group label, one of "shadowtext" and "ggforce".} 72 | 73 | \item{label_format}{a numeric value sets wrap length, alternatively a custom function to format axis labels.} 74 | 75 | \item{clusterFunction}{function of Clustering method, such as stats::kmeans(the default), 76 | cluster::clara, cluster::fanny or cluster::pam.} 77 | 78 | \item{nWords}{Numeric, the number of words in the cluster tags, the default value is 4.} 79 | 80 | \item{nCluster}{Numeric, the number of clusters, 81 | the default value is square root of the number of nodes.} 82 | } 83 | \value{ 84 | ggplot object 85 | } 86 | \description{ 87 | Enrichment Map for enrichment result of 88 | over-representation test or gene set enrichment analysis 89 | } 90 | \details{ 91 | This function visualizes gene sets as a network (i.e. enrichment map). 92 | Mutually overlapping gene sets tend to cluster together, making it 93 | easier for interpretation. When the similarity between terms meets 94 | a certain threshold (default is 0.2, adjusted by parameter `min_edge`), 95 | there will be edges between terms. The stronger the similarity, 96 | the shorter and thicker the edges. The similarity between terms is 97 | obtained by function `pairwise_termsim`, the details of similarity 98 | calculation can be found in its documentation: \link{pairwise_termsim}. 99 | } 100 | \examples{ 101 | \dontrun{ 102 | library(DOSE) 103 | data(geneList) 104 | de <- names(geneList)[1:100] 105 | x <- enrichDO(de) 106 | x2 <- pairwise_termsim(x) 107 | emapplot(x2) 108 | # use `layout` to change the layout of map 109 | emapplot(x2, layout = "star") 110 | # use `showCategory` to select the displayed terms. It can be a number of a vector of terms. 111 | emapplot(x2, showCategory = 10) 112 | categorys <- c("pre-malignant neoplasm", "intestinal disease", 113 | "breast ductal carcinoma") 114 | emapplot(x2, showCategory = categorys) 115 | 116 | # It can also graph compareClusterResult 117 | library(clusterProfiler) 118 | library(DOSE) 119 | library(org.Hs.eg.db) 120 | data(gcSample) 121 | xx <- compareCluster(gcSample, fun="enrichGO", OrgDb="org.Hs.eg.db") 122 | xx2 <- pairwise_termsim(xx) 123 | emapplot(xx2) 124 | } 125 | } 126 | \author{ 127 | Guangchuang Yu 128 | } 129 | -------------------------------------------------------------------------------- /man/enrichplot-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/enrichplot-package.R 3 | \docType{package} 4 | \name{enrichplot-package} 5 | \alias{enrichplot} 6 | \alias{enrichplot-package} 7 | \title{enrichplot: Visualization of Functional Enrichment Result} 8 | \description{ 9 | The 'enrichplot' package implements several visualization methods for interpreting functional enrichment results obtained from ORA or GSEA analysis. It is mainly designed to work with the 'clusterProfiler' package suite. All the visualization methods are developed based on 'ggplot2' graphics. 10 | } 11 | \seealso{ 12 | Useful links: 13 | \itemize{ 14 | \item \url{https://yulab-smu.top/contribution-knowledge-mining/} 15 | \item Report bugs at \url{https://github.com/GuangchuangYu/enrichplot/issues} 16 | } 17 | 18 | } 19 | \author{ 20 | \strong{Maintainer}: Guangchuang Yu \email{guangchuangyu@gmail.com} (\href{https://orcid.org/0000-0002-6485-8781}{ORCID}) 21 | 22 | Other contributors: 23 | \itemize{ 24 | \item Chun-Hui Gao \email{gaospecial@gmail.com} (\href{https://orcid.org/0000-0002-1445-7939}{ORCID}) [contributor] 25 | } 26 | 27 | } 28 | \keyword{internal} 29 | -------------------------------------------------------------------------------- /man/fortify.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method-fortify.R 3 | \name{fortify.compareClusterResult} 4 | \alias{fortify.compareClusterResult} 5 | \alias{fortify.enrichResult} 6 | \title{fortify} 7 | \usage{ 8 | \method{fortify}{compareClusterResult}( 9 | model, 10 | data, 11 | showCategory = 5, 12 | by = "geneRatio", 13 | split = NULL, 14 | includeAll = TRUE, 15 | ... 16 | ) 17 | 18 | \method{fortify}{enrichResult}( 19 | model, 20 | data, 21 | showCategory = 5, 22 | by = "Count", 23 | order = FALSE, 24 | drop = FALSE, 25 | split = NULL, 26 | ... 27 | ) 28 | } 29 | \arguments{ 30 | \item{model}{'enrichResult' or 'compareClusterResult' object} 31 | 32 | \item{data}{not use here} 33 | 34 | \item{showCategory}{Category numbers to show} 35 | 36 | \item{by}{one of Count and GeneRatio} 37 | 38 | \item{split}{separate result by 'split' variable} 39 | 40 | \item{includeAll}{logical} 41 | 42 | \item{...}{additional parameter} 43 | 44 | \item{order}{logical} 45 | 46 | \item{drop}{logical} 47 | } 48 | \value{ 49 | data.frame 50 | 51 | data.frame 52 | } 53 | \description{ 54 | convert compareClusterResult to a data.frame that ready for plot 55 | 56 | convert enrichResult object for ggplot2 57 | } 58 | \author{ 59 | Guangchuang Yu 60 | } 61 | -------------------------------------------------------------------------------- /man/geom_gsea_gene.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gseaplot.R 3 | \name{geom_gsea_gene} 4 | \alias{geom_gsea_gene} 5 | \title{geom_gsea_gene} 6 | \usage{ 7 | geom_gsea_gene( 8 | genes, 9 | mapping = NULL, 10 | geom = ggplot2::geom_text, 11 | ..., 12 | geneSet = NULL 13 | ) 14 | } 15 | \arguments{ 16 | \item{genes}{selected genes to be labeled} 17 | 18 | \item{mapping}{aesthetic mapping, default is NULL} 19 | 20 | \item{geom}{geometric layer to plot the gene labels, default is geom_text} 21 | 22 | \item{...}{additional parameters passed to the 'geom'} 23 | 24 | \item{geneSet}{choose which gene set(s) to be label if the plot contains multiple gene sets} 25 | } 26 | \value{ 27 | ggplot object 28 | } 29 | \description{ 30 | label genes in running score plot 31 | } 32 | \author{ 33 | Guangchuang Yu 34 | } 35 | -------------------------------------------------------------------------------- /man/ggtable.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggtable.R 3 | \name{ggtable} 4 | \alias{ggtable} 5 | \title{ggtable} 6 | \usage{ 7 | ggtable(d, p = NULL) 8 | } 9 | \arguments{ 10 | \item{d}{data frame} 11 | 12 | \item{p}{ggplot object to extract color to color rownames(d), optional} 13 | } 14 | \value{ 15 | ggplot object 16 | } 17 | \description{ 18 | plot table 19 | } 20 | \author{ 21 | guangchuang yu 22 | } 23 | -------------------------------------------------------------------------------- /man/goplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/goplot.R 3 | \name{goplot} 4 | \alias{goplot} 5 | \alias{goplot,enrichResult-method} 6 | \alias{goplot,gseaResult-method} 7 | \title{goplot} 8 | \usage{ 9 | goplot( 10 | x, 11 | showCategory = 10, 12 | color = "p.adjust", 13 | layout = "sugiyama", 14 | geom = "text", 15 | ... 16 | ) 17 | 18 | \S4method{goplot}{enrichResult}( 19 | x, 20 | showCategory = 10, 21 | color = "p.adjust", 22 | layout = igraph::layout_with_sugiyama, 23 | geom = "text", 24 | ... 25 | ) 26 | 27 | \S4method{goplot}{gseaResult}( 28 | x, 29 | showCategory = 10, 30 | color = "p.adjust", 31 | layout = igraph::layout_with_sugiyama, 32 | geom = "text", 33 | ... 34 | ) 35 | } 36 | \arguments{ 37 | \item{x}{enrichment result.} 38 | 39 | \item{showCategory}{number of enriched terms to display} 40 | 41 | \item{color}{variable that used to color enriched terms, e.g. pvalue, 42 | p.adjust or qvalue} 43 | 44 | \item{layout}{layout of the map} 45 | 46 | \item{geom}{label geom, one of 'label' or 'text'} 47 | 48 | \item{...}{additional parameter} 49 | } 50 | \value{ 51 | ggplot object 52 | } 53 | \description{ 54 | plot induced GO DAG of significant terms 55 | } 56 | \examples{ 57 | \dontrun{ 58 | library(clusterProfiler) 59 | data(geneList, package = "DOSE") 60 | de <- names(geneList)[1:100] 61 | yy <- enrichGO(de, 'org.Hs.eg.db', ont="BP", pvalueCutoff=0.01) 62 | goplot(yy) 63 | goplot(yy, showCategory = 5) 64 | } 65 | } 66 | \author{ 67 | Guangchuang Yu 68 | } 69 | -------------------------------------------------------------------------------- /man/gsInfo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gseaplot.R 3 | \name{gsInfo} 4 | \alias{gsInfo} 5 | \title{gsInfo} 6 | \usage{ 7 | gsInfo(object, geneSetID) 8 | } 9 | \arguments{ 10 | \item{object}{gseaResult object} 11 | 12 | \item{geneSetID}{gene set ID} 13 | } 14 | \value{ 15 | data.frame 16 | } 17 | \description{ 18 | extract gsea result of selected geneSet 19 | } 20 | \author{ 21 | Guangchuang Yu 22 | } 23 | -------------------------------------------------------------------------------- /man/gseadist.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/densityplot.R 3 | \name{gseadist} 4 | \alias{gseadist} 5 | \title{gseadist} 6 | \usage{ 7 | gseadist(x, IDs, type = "density") 8 | } 9 | \arguments{ 10 | \item{x}{GSEA result} 11 | 12 | \item{IDs}{gene set IDs} 13 | 14 | \item{type}{one of 'density' or 'boxplot'} 15 | } 16 | \value{ 17 | distribution plot 18 | } 19 | \description{ 20 | plot logFC distribution of selected gene sets 21 | } 22 | \author{ 23 | Guangchuang Yu 24 | } 25 | -------------------------------------------------------------------------------- /man/gseaplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/gseaplot.R 3 | \name{gseaplot} 4 | \alias{gseaplot} 5 | \alias{gseaplot,gseaResult-method} 6 | \alias{gseaplot.gseaResult} 7 | \title{gseaplot} 8 | \usage{ 9 | gseaplot(x, geneSetID, by = "all", title = "", ...) 10 | 11 | \S4method{gseaplot}{gseaResult}( 12 | x, 13 | geneSetID, 14 | by = "all", 15 | title = "", 16 | color = "black", 17 | color.line = "green", 18 | color.vline = "#FA5860", 19 | ... 20 | ) 21 | 22 | gseaplot.gseaResult( 23 | x, 24 | geneSetID, 25 | by = "all", 26 | title = "", 27 | color = "black", 28 | color.line = "green", 29 | color.vline = "#FA5860", 30 | ... 31 | ) 32 | } 33 | \arguments{ 34 | \item{x}{object of gsea result} 35 | 36 | \item{geneSetID}{geneSet ID} 37 | 38 | \item{by}{one of "runningScore" or "position"} 39 | 40 | \item{title}{plot title} 41 | 42 | \item{...}{additional parameters} 43 | 44 | \item{color}{color of line segments} 45 | 46 | \item{color.line}{color of running enrichment score line} 47 | 48 | \item{color.vline}{color of vertical line which indicating the 49 | maximum/minimal running enrichment score} 50 | } 51 | \value{ 52 | ggplot2 object 53 | 54 | ggplot2 object 55 | } 56 | \description{ 57 | visualize analyzing result of GSEA 58 | } 59 | \details{ 60 | plotting function for gseaResult 61 | } 62 | \examples{ 63 | library(DOSE) 64 | data(geneList) 65 | x <- gseDO(geneList) 66 | gseaplot(x, geneSetID=1) 67 | } 68 | \author{ 69 | Guangchuang Yu 70 | } 71 | -------------------------------------------------------------------------------- /man/gseaplot2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gseaplot.R 3 | \name{gseaplot2} 4 | \alias{gseaplot2} 5 | \title{gseaplot2} 6 | \usage{ 7 | gseaplot2( 8 | x, 9 | geneSetID, 10 | title = "", 11 | color = "green", 12 | base_size = 11, 13 | rel_heights = c(1.5, 0.5, 1), 14 | subplots = 1:3, 15 | pvalue_table = FALSE, 16 | ES_geom = "line" 17 | ) 18 | } 19 | \arguments{ 20 | \item{x}{gseaResult object} 21 | 22 | \item{geneSetID}{gene set ID} 23 | 24 | \item{title}{plot title} 25 | 26 | \item{color}{color of running enrichment score line} 27 | 28 | \item{base_size}{base font size} 29 | 30 | \item{rel_heights}{relative heights of subplots} 31 | 32 | \item{subplots}{which subplots to be displayed} 33 | 34 | \item{pvalue_table}{whether add pvalue table} 35 | 36 | \item{ES_geom}{geom for plotting running enrichment score, 37 | one of 'line' or 'dot'} 38 | } 39 | \value{ 40 | plot 41 | } 42 | \description{ 43 | GSEA plot that mimic the plot generated by broad institute's GSEA software 44 | } 45 | \author{ 46 | Guangchuang Yu 47 | } 48 | -------------------------------------------------------------------------------- /man/gsearank.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gseaplot.R 3 | \name{gsearank} 4 | \alias{gsearank} 5 | \title{gsearank} 6 | \usage{ 7 | gsearank(x, geneSetID, title = "", output = "plot") 8 | } 9 | \arguments{ 10 | \item{x}{gseaResult object} 11 | 12 | \item{geneSetID}{gene set ID} 13 | 14 | \item{title}{plot title} 15 | 16 | \item{output}{one of 'plot' or 'table' (for exporting data)} 17 | } 18 | \value{ 19 | ggplot object 20 | } 21 | \description{ 22 | plot ranked list of genes with running enrichment score as bar height 23 | } 24 | \author{ 25 | Guangchuang Yu 26 | } 27 | -------------------------------------------------------------------------------- /man/heatplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/heatplot.R 3 | \name{heatplot} 4 | \alias{heatplot} 5 | \alias{heatplot,enrichResult-method} 6 | \alias{heatplot,gseaResult-method} 7 | \alias{heatplot.enrichResult} 8 | \title{heatplot} 9 | \usage{ 10 | heatplot(x, showCategory = 30, ...) 11 | 12 | \S4method{heatplot}{enrichResult}(x, showCategory = 30, ...) 13 | 14 | \S4method{heatplot}{gseaResult}(x, showCategory = 30, ...) 15 | 16 | heatplot.enrichResult( 17 | x, 18 | showCategory = 30, 19 | symbol = "rect", 20 | foldChange = NULL, 21 | pvalue = NULL, 22 | label_format = 30 23 | ) 24 | } 25 | \arguments{ 26 | \item{x}{enrichment result.} 27 | 28 | \item{showCategory}{number of enriched terms to display} 29 | 30 | \item{...}{Additional parameters} 31 | 32 | \item{symbol}{symbol of the nodes, one of "rect"(the default) and "dot" 33 | by default wraps names longer that 30 characters} 34 | 35 | \item{foldChange}{fold Change.} 36 | 37 | \item{pvalue}{pvalue of genes} 38 | 39 | \item{label_format}{a numeric value sets wrap length, alternatively a 40 | custom function to format axis labels.} 41 | } 42 | \value{ 43 | ggplot object 44 | } 45 | \description{ 46 | heatmap like plot for functional classification 47 | } 48 | \examples{ 49 | library(DOSE) 50 | data(geneList) 51 | de <- names(geneList)[1:100] 52 | x <- enrichDO(de) 53 | heatplot(x) 54 | } 55 | \author{ 56 | Guangchuang Yu 57 | } 58 | -------------------------------------------------------------------------------- /man/hplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gseaplot.R 3 | \name{hplot} 4 | \alias{hplot} 5 | \title{hplot} 6 | \usage{ 7 | hplot(x, geneSetID) 8 | } 9 | \arguments{ 10 | \item{x}{gseaResult object} 11 | 12 | \item{geneSetID}{gene set ID} 13 | } 14 | \value{ 15 | horizontal plot 16 | } 17 | \description{ 18 | Horizontal plot for GSEA result 19 | } 20 | \author{ 21 | Guangchuang Yu 22 | } 23 | -------------------------------------------------------------------------------- /man/pairwise_termsim.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/pairwise_termsim.R 3 | \name{pairwise_termsim} 4 | \alias{pairwise_termsim} 5 | \alias{pairwise_termsim,enrichResult-method} 6 | \alias{pairwise_termsim,gseaResult-method} 7 | \alias{pairwise_termsim,compareClusterResult-method} 8 | \alias{pairwise_termsim.enrichResult} 9 | \alias{pairwise_termsim.compareClusterResult} 10 | \title{pairwise_termsim} 11 | \usage{ 12 | pairwise_termsim(x, method = "JC", semData = NULL, showCategory = 200) 13 | 14 | \S4method{pairwise_termsim}{enrichResult}(x, method = "JC", semData = NULL, showCategory = 200) 15 | 16 | \S4method{pairwise_termsim}{gseaResult}(x, method = "JC", semData = NULL, showCategory = 200) 17 | 18 | \S4method{pairwise_termsim}{compareClusterResult}(x, method = "JC", semData = NULL, showCategory = 200) 19 | 20 | pairwise_termsim.enrichResult( 21 | x, 22 | method = "JC", 23 | semData = NULL, 24 | showCategory = 200 25 | ) 26 | 27 | pairwise_termsim.compareClusterResult( 28 | x, 29 | method = "JC", 30 | semData = NULL, 31 | showCategory = 200 32 | ) 33 | } 34 | \arguments{ 35 | \item{x}{enrichment result.} 36 | 37 | \item{method}{method of calculating the similarity between nodes, 38 | one of "Resnik", "Lin", "Rel", "Jiang" , "Wang" and 39 | "JC"(Jaccard similarity coefficient) methods.} 40 | 41 | \item{semData}{GOSemSimDATA object, can be obtained through 42 | \link{godata} function in GOSemSim package.} 43 | 44 | \item{showCategory}{number of enriched terms to display, default value is 200.} 45 | } 46 | \description{ 47 | Get the similarity matrix 48 | } 49 | \details{ 50 | This function add similarity matrix to the termsim slot of enrichment result. 51 | Users can use the `method` parameter to select the method of calculating similarity. 52 | The Jaccard correlation coefficient(JC) is used by default, and it applies to all situations. 53 | When users want to calculate the correlation between GO terms or DO terms, they can also choose 54 | "Resnik", "Lin", "Rel" or "Jiang" (they are semantic similarity calculation methods from GOSemSim packages), 55 | and at this time, the user needs to provide `semData` parameter, which can be obtained through 56 | \link{godata} function in GOSemSim package. 57 | } 58 | \examples{ 59 | \dontrun{ 60 | library(clusterProfiler) 61 | library(org.Hs.eg.db) 62 | library(enrichplot) 63 | library(GOSemSim) 64 | library(DOSE) 65 | data(geneList) 66 | gene <- names(geneList)[abs(geneList) > 2] 67 | ego <- enrichGO(gene = gene, 68 | universe = names(geneList), 69 | OrgDb = org.Hs.eg.db, 70 | ont = "BP", 71 | pAdjustMethod = "BH", 72 | pvalueCutoff = 0.01, 73 | qvalueCutoff = 0.05, 74 | readable = TRUE) 75 | d <- godata('org.Hs.eg.db', ont="BP") 76 | ego2 <- pairwise_termsim(ego, method="Wang", semData = d) 77 | emapplot(ego2) 78 | emapplot_cluster(ego2) 79 | } 80 | } 81 | -------------------------------------------------------------------------------- /man/plotting.clusterProfile.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{plotting.clusterProfile} 4 | \alias{plotting.clusterProfile} 5 | \title{plotting-clusterProfile} 6 | \usage{ 7 | plotting.clusterProfile( 8 | clProf.reshape.df, 9 | x = ~Cluster, 10 | type = "dot", 11 | colorBy = "p.adjust", 12 | by = "geneRatio", 13 | title = "", 14 | font.size = 12 15 | ) 16 | } 17 | \arguments{ 18 | \item{clProf.reshape.df}{data frame of compareCluster result} 19 | 20 | \item{x}{x variable} 21 | 22 | \item{type}{one of dot and bar} 23 | 24 | \item{colorBy}{one of pvalue or p.adjust} 25 | 26 | \item{by}{one of percentage and count} 27 | 28 | \item{title}{graph title} 29 | 30 | \item{font.size}{graph font size} 31 | } 32 | \value{ 33 | ggplot object 34 | } 35 | \description{ 36 | Internal plot function for plotting compareClusterResult 37 | } 38 | \author{ 39 | Guangchuang Yu \url{https://yulab-smu.top} 40 | } 41 | -------------------------------------------------------------------------------- /man/pmcplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pmcplot.R 3 | \name{pmcplot} 4 | \alias{pmcplot} 5 | \title{pmcplot} 6 | \usage{ 7 | pmcplot(query, period, proportion = TRUE) 8 | } 9 | \arguments{ 10 | \item{query}{query terms} 11 | 12 | \item{period}{period of query in the unit of year} 13 | 14 | \item{proportion}{If TRUE, use query_hits/all_hits, otherwise use query_hits} 15 | } 16 | \value{ 17 | ggplot object 18 | } 19 | \description{ 20 | PubMed Central Trend plot 21 | } 22 | \author{ 23 | guangchuang yu 24 | } 25 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reexport.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{ggtitle} 7 | \alias{facet_grid} 8 | \alias{plot_list} 9 | \alias{cnetplot} 10 | \alias{geom_cnet_label} 11 | \title{Objects exported from other packages} 12 | \keyword{internal} 13 | \description{ 14 | These objects are imported from other packages. Follow the links 15 | below to see their documentation. 16 | 17 | \describe{ 18 | \item{aplot}{\code{\link[aplot]{plot_list}}} 19 | 20 | \item{ggplot2}{\code{\link[ggplot2]{facet_grid}}, \code{\link[ggplot2:labs]{ggtitle}}} 21 | 22 | \item{ggtangle}{\code{\link[ggtangle]{cnetplot}}, \code{\link[ggtangle]{geom_cnet_label}}} 23 | }} 24 | 25 | -------------------------------------------------------------------------------- /man/ridgeplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/ridgeplot.R 3 | \name{ridgeplot} 4 | \alias{ridgeplot} 5 | \alias{ridgeplot,gseaResult-method} 6 | \alias{ridgeplot.gseaResult} 7 | \title{ridgeplot} 8 | \usage{ 9 | ridgeplot( 10 | x, 11 | showCategory = 30, 12 | fill = "p.adjust", 13 | core_enrichment = TRUE, 14 | label_format = 30, 15 | ... 16 | ) 17 | 18 | \S4method{ridgeplot}{gseaResult}( 19 | x, 20 | showCategory = 30, 21 | fill = "p.adjust", 22 | core_enrichment = TRUE, 23 | label_format = 30, 24 | ... 25 | ) 26 | 27 | ridgeplot.gseaResult( 28 | x, 29 | showCategory = 30, 30 | fill = "p.adjust", 31 | core_enrichment = TRUE, 32 | label_format = 30, 33 | orderBy = "NES", 34 | decreasing = FALSE 35 | ) 36 | } 37 | \arguments{ 38 | \item{x}{gseaResult object} 39 | 40 | \item{showCategory}{A number or a vector of terms. If it is a number, 41 | the first n terms will be displayed. If it is a vector of terms, 42 | the selected terms will be displayed.} 43 | 44 | \item{fill}{one of "pvalue", "p.adjust", "qvalue"} 45 | 46 | \item{core_enrichment}{whether only using core_enriched genes} 47 | 48 | \item{label_format}{a numeric value sets wrap length, alternatively a 49 | custom function to format axis labels.} 50 | 51 | \item{...}{additional parameters 52 | by default wraps names longer that 30 characters} 53 | 54 | \item{orderBy}{The order of the Y-axis} 55 | 56 | \item{decreasing}{logical. Should the orderBy order be increasing or decreasing?} 57 | } 58 | \value{ 59 | ggplot object 60 | } 61 | \description{ 62 | ridgeline plot for GSEA result 63 | } 64 | \examples{ 65 | library(DOSE) 66 | data(geneList) 67 | x <- gseDO(geneList) 68 | ridgeplot(x) 69 | } 70 | \author{ 71 | Guangchuang Yu 72 | } 73 | -------------------------------------------------------------------------------- /man/set_enrichplot_color.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{set_enrichplot_color} 4 | \alias{set_enrichplot_color} 5 | \title{set_enrichplot_color} 6 | \usage{ 7 | set_enrichplot_color( 8 | colors = get_enrichplot_color(2), 9 | type = "color", 10 | name = NULL, 11 | .fun = NULL, 12 | reverse = TRUE, 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{colors}{user provided color vector} 18 | 19 | \item{type}{one of 'color', 'colour' or 'fill'} 20 | 21 | \item{name}{name of the color legend} 22 | 23 | \item{.fun}{force to use user provided color scale function} 24 | 25 | \item{reverse}{whether reverse the color scheme, default is TRUE as it is more significant for lower pvalue} 26 | 27 | \item{...}{additional parameter that passed to the color scale function} 28 | } 29 | \value{ 30 | a color scale 31 | } 32 | \description{ 33 | helper function to set color for enrichplot 34 | } 35 | -------------------------------------------------------------------------------- /man/ssplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/ssplot.R 3 | \name{ssplot} 4 | \alias{ssplot} 5 | \alias{ssplot,enrichResult-method} 6 | \alias{ssplot,gseaResult-method} 7 | \alias{ssplot,compareClusterResult-method} 8 | \alias{ssplot.enrichResult} 9 | \alias{ssplot.compareClusterResult} 10 | \title{ssplot} 11 | \usage{ 12 | ssplot(x, ...) 13 | 14 | \S4method{ssplot}{enrichResult}(x, showCategory = 30, ...) 15 | 16 | \S4method{ssplot}{gseaResult}(x, showCategory = 30, ...) 17 | 18 | \S4method{ssplot}{compareClusterResult}(x, showCategory = 30, ...) 19 | 20 | ssplot.enrichResult( 21 | x, 22 | showCategory = 30, 23 | drfun = NULL, 24 | dr.params = list(), 25 | group = TRUE, 26 | node_label = "group", 27 | ... 28 | ) 29 | 30 | ssplot.compareClusterResult( 31 | x, 32 | showCategory = 30, 33 | pie = "equal", 34 | drfun = NULL, 35 | dr.params = list(), 36 | group = TRUE, 37 | node_label = "group", 38 | ... 39 | ) 40 | } 41 | \arguments{ 42 | \item{x}{Enrichment result.} 43 | 44 | \item{...}{additional parameters 45 | 46 | additional parameters can refer the following parameters. 47 | \itemize{ 48 | \item \code{color} Variable that used to color enriched terms, e.g. 'pvalue','p.adjust' or 'qvalue'. 49 | the starting position of each text label. 50 | \item \code{size_edge} Scale of line width. 51 | \item \code{min_edge} The minimum similarity threshold for whether 52 | two nodes are connected, should between 0 and 1, default value is 0.2. 53 | \item \code{size_category} Number indicating the amount by which plotting category 54 | nodes should be scaled relative to the default. 55 | \item \code{label_style} style of group label, one of "shadowtext" and "ggforce". 56 | \item \code{group} Logical, if TRUE, the grouping legend will be displayed. 57 | The default is FALSE. 58 | \item \code{nWords} Numeric, the number of words in the cluster tags, the default value is 4. 59 | \item \code{label_format} a numeric value sets wrap length, alternatively a 60 | custom function to format axis labels. 61 | \item \code{clusterFunction} function of Clustering method, such as stats::kmeans(the default), 62 | cluster::clara, cluster::fanny or cluster::pam. 63 | \item \code{nCluster} Numeric, the number of clusters, 64 | the default value is square root of the number of nodes. 65 | } 66 | 67 | additional parameters can refer the emapplot function: \link{emapplot}.} 68 | 69 | \item{showCategory}{A number or a vector of terms. If it is a number, 70 | the first n terms will be displayed. If it is a vector of terms, 71 | the selected terms will be displayed.} 72 | 73 | \item{drfun}{The function used for dimension reduction, 74 | e.g. stats::cmdscale (the default), vegan::metaMDS, or ape::pcoa.} 75 | 76 | \item{dr.params}{list, the parameters of tidydr::dr. one of 'category', 'group', 'all' and 'none'.} 77 | 78 | \item{group}{logical, if TRUE, group the category.} 79 | 80 | \item{node_label}{Select which labels to be displayed, 81 | one of 'category', 'group', 'all' and 'none'.} 82 | 83 | \item{pie}{one of 'equal' or 'Count' to set the slice ratio of the pies} 84 | } 85 | \value{ 86 | ggplot object 87 | } 88 | \description{ 89 | Similarity space plot of enrichment analysis results. 90 | } 91 | \examples{ 92 | \dontrun{ 93 | library(clusterProfiler) 94 | library(org.Hs.eg.db) 95 | library(enrichplot) 96 | library(GOSemSim) 97 | library(DOSE) 98 | data(geneList) 99 | gene <- names(geneList)[abs(geneList) > 2] 100 | ego <- enrichGO(gene = gene, 101 | universe = names(geneList), 102 | OrgDb = org.Hs.eg.db, 103 | ont = "BP", 104 | pAdjustMethod = "BH", 105 | pvalueCutoff = 0.01, 106 | qvalueCutoff = 0.05, 107 | readable = TRUE) 108 | d <- godata('org.Hs.eg.db', ont="BP") 109 | ego2 <- pairwise_termsim(ego, method = "Wang", semData = d) 110 | ssplot(ego2) 111 | } 112 | } 113 | \author{ 114 | Guangchuang Yu 115 | } 116 | -------------------------------------------------------------------------------- /man/treeplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/treeplot.R 3 | \name{treeplot} 4 | \alias{treeplot} 5 | \alias{treeplot,enrichResult-method} 6 | \alias{treeplot,gseaResult-method} 7 | \alias{treeplot,compareClusterResult-method} 8 | \alias{treeplot.enrichResult} 9 | \alias{treeplot.compareClusterResult} 10 | \title{treeplot} 11 | \usage{ 12 | treeplot(x, ...) 13 | 14 | \S4method{treeplot}{enrichResult}(x, ...) 15 | 16 | \S4method{treeplot}{gseaResult}(x, ...) 17 | 18 | \S4method{treeplot}{compareClusterResult}(x, ...) 19 | 20 | treeplot.enrichResult( 21 | x, 22 | showCategory = 30, 23 | color = "p.adjust", 24 | nWords = 4, 25 | nCluster = 5, 26 | cex_category = 1, 27 | label_format = NULL, 28 | label_format_cladelab = 30, 29 | label_format_tiplab = NULL, 30 | fontsize = 4, 31 | offset = rel(1), 32 | offset_tiplab = rel(1), 33 | hclust_method = "ward.D", 34 | group_color = NULL, 35 | extend = 0.3, 36 | hilight = TRUE, 37 | hexpand = 0.1, 38 | align = "both", 39 | hilight.params = list(hilight = TRUE, align = "both"), 40 | offset.params = list(bar_tree = rel(1), tiplab = rel(1), extend = 0.3, hexpand = 0.1), 41 | cluster.params = list(method = "ward.D", n = 5, color = NULL, label_words_n = 4, 42 | label_format = 30), 43 | ... 44 | ) 45 | 46 | treeplot.compareClusterResult( 47 | x, 48 | showCategory = 5, 49 | color = "p.adjust", 50 | nWords = 4, 51 | nCluster = 5, 52 | cex_category = 1, 53 | split = NULL, 54 | label_format = NULL, 55 | label_format_cladelab = 30, 56 | label_format_tiplab = NULL, 57 | fontsize = 4, 58 | offset = rel(1), 59 | pie = "equal", 60 | legend_n = 3, 61 | offset_tiplab = rel(1), 62 | hclust_method = "ward.D", 63 | group_color = NULL, 64 | extend = 0.3, 65 | hilight = TRUE, 66 | geneClusterPanel = "heatMap", 67 | hexpand = 0.1, 68 | align = "both", 69 | cluster.params = list(method = "ward.D", n = 5, color = NULL, label_words_n = 4, 70 | label_format = 30), 71 | hilight.params = list(hilight = TRUE, align = "both"), 72 | clusterPanel.params = list(clusterPanel = "heatMap", pie = "equal", legend_n = 3, 73 | colnames_angle = 0), 74 | offset.params = list(bar_tree = rel(1), tiplab = rel(1), extend = 0.3, hexpand = 0.1), 75 | ... 76 | ) 77 | } 78 | \arguments{ 79 | \item{x}{enrichment result.} 80 | 81 | \item{...}{additional parameters} 82 | 83 | \item{showCategory}{number of enriched terms to display} 84 | 85 | \item{color}{variable that used to color enriched terms, e.g. pvalue, 86 | p.adjust or qvalue} 87 | 88 | \item{nWords}{The number of words in the cluster tags. 89 | Will be removed in the next version.} 90 | 91 | \item{nCluster}{The number of clusters, the default value is 5. 92 | Will be removed in the next version.} 93 | 94 | \item{cex_category}{Number indicating the amount by which plotting category. 95 | nodes should be scaled relative to the default. 96 | Will be removed in the next version.} 97 | 98 | \item{label_format}{a numeric value sets wrap length, alternatively a 99 | custom function to format axis labels.} 100 | 101 | \item{label_format_cladelab}{label_format for group labels, a numeric value sets wrap length, 102 | alternatively a custom function to format axis labels. 103 | Will be removed in the next version.} 104 | 105 | \item{label_format_tiplab}{label_format for tiplabs, a numeric value sets wrap length, 106 | alternatively a custom function to format axis labels. 107 | Will be removed in the next version.} 108 | 109 | \item{fontsize}{The size of text, default is 4.} 110 | 111 | \item{offset}{rel object or numeric value, distance bar and tree, 112 | offset of bar and text from the clade, default is rel(1), 113 | meaning 1 * 1.2 * x_range_of_tree plus distance_between_tree_and_tiplab 114 | (1 * (1.2 * x_range_of_tree + distance_between_tree_and_tiplab)). 115 | Will be removed in the next version.} 116 | 117 | \item{offset_tiplab}{tiplab offset, rel object or numeric value, the bigger the number, 118 | the farther the distance between the node and the branch. 119 | The default is rel(1), when geneClusterPanel = "pie", meaning 1 * max_radius_of_the_pies; 120 | when geneClusterPanel = "heatMap", meaning 1 * 0.16 * column_number_of_heatMap * x_range_of_tree; 121 | when geneClusterPanel = "dotplot", meaning 1 * 0.09 * column_number_of_dotplot * x_range_of_tree. 122 | Will be removed in the next version.} 123 | 124 | \item{hclust_method}{Method of hclust. This should be (an unambiguous abbreviation of) one of "ward.D", 125 | "ward.D2", "single", "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) or "centroid" (= UPGMC). 126 | Will be removed in the next version.} 127 | 128 | \item{group_color}{A vector of group colors, the length of the vector should be the same as nCluster. 129 | Will be removed in the next version.} 130 | 131 | \item{extend}{Numeric, extend the length of bar, default is 0.3. 132 | Will be removed in the next version.} 133 | 134 | \item{hilight}{Logical value, if TRUE(default), add ggtree::geom_hilight() layer. 135 | Will be removed in the next version.} 136 | 137 | \item{hexpand}{expand x limits by amount of xrange * hexpand. 138 | Will be removed in the next version.} 139 | 140 | \item{align}{control the align direction of the edge of high light rectangular. 141 | Options is 'none', 'left', 'right', 'both (default)'. 142 | Will be removed in the next version.} 143 | 144 | \item{hilight.params}{list, the parameters to control the attributes of highlight layer. 145 | see the hilight.params in the following. 146 | hilight.params control the attributes of highlight layer, it can be referred to the following parameters: 147 | \itemize{ 148 | \item \code{hilight} Logical value, if TRUE(default), add ggtree::geom_hilight() layer. 149 | \item \code{align} control the align direction of the edge of high light rectangular. 150 | Options is 'none', 'left', 'right', 'both (default)'. 151 | }} 152 | 153 | \item{offset.params}{list, the parameters to control the offset. 154 | see the offset.params in the following. 155 | offset.params control the attributes of offset, it can be referred to the following parameters: 156 | \itemize{ 157 | \item \code{bar_tree} rel object or numeric value, distance bar and tree, 158 | offset of bar and text from the clade, default is rel(1), 159 | meaning 1 * 1.2 * x_range_of_tree plus distance_between_tree_and_tiplab 160 | (1 * (1.2 * x_range_of_tree + distance_between_tree_and_tiplab)). 161 | \item \code{tiplab} tiplab offset, rel object or numeric value, the bigger the number, 162 | the farther the distance between the node and the branch. 163 | The default is rel(1), when clusterPanel = "pie", meaning 1 * max_radius_of_the_pies; 164 | when clusterPanel = "heatMap", meaning 1 * 0.16 * column_number_of_heatMap * x_range_of_tree; 165 | when clusterPanel = "dotplot", meaning 1 * 0.09 * column_number_of_dotplot * x_range_of_tree. 166 | \item \code{extend} Numeric, extend the length of bar, default is 0.3. 167 | \item \code{hexpand} expand x limits by amount of xrange * hexpand. 168 | }} 169 | 170 | \item{cluster.params}{list, the parameters to control the attributes of highlighted nodes and edges. 171 | see the cluster.params in the following. 172 | cluster.params control the attributes of highlight, it can be referred to the following parameters: 173 | \itemize{ 174 | \item \code{method} function of Clustering method, such as stats::kmeans(the default), 175 | cluster::clara, cluster::fanny or cluster::pam. 176 | \item \code{n} Numeric, the number of clusters, 177 | the default value is square root of the number of nodes. 178 | \item \code{color} A vector of group colors, the length of the vector should be the same as nCluster. 179 | \item \code{label_words_n} Numeric, the number of words in the cluster tags, the default value is 4. 180 | \item \code{label_format} A numeric value sets wrap length, alternatively a 181 | custom function to format axis labels. 182 | }} 183 | 184 | \item{split}{Separate result by 'category' variable.} 185 | 186 | \item{pie}{Used only when geneClusterPanel = "pie", 187 | proportion of clusters in the pie chart, one of 'equal' (default) and 'Count'. 188 | Will be removed in the next version.} 189 | 190 | \item{legend_n}{Number of circle in legend, the default value is 3. 191 | Will be removed in the next version.} 192 | 193 | \item{geneClusterPanel}{one of "heatMap"(default), "dotplot", "pie". 194 | Will be removed in the next version.} 195 | 196 | \item{clusterPanel.params}{list, the parameters to control the attributes of cluster panel. 197 | see the clusterPanel.params in the following. 198 | clusterPanel.params control the attributes of cluster panel, it can be referred to the following parameters: 199 | \itemize{ 200 | \item \code{clusterPanel} one of "heatMap"(default), "dotplot", "pie". 201 | \item \code{pie} pUsed only when ClusterPanel = "pie", 202 | proportion of clusters in the pie chart, one of 'equal' (default) and 'Count'. 203 | \item \code{legend_n} number of circle in legend. 204 | \item \code{colnames_angle} set the angle of colnames. 205 | }} 206 | } 207 | \value{ 208 | ggplot object 209 | } 210 | \description{ 211 | Functional grouping tree diagram for enrichment result of 212 | over-representation test or gene set enrichment analysis. 213 | } 214 | \details{ 215 | This function visualizes gene sets as a tree. 216 | Gene sets with high similarity tend to cluster together, making it easier 217 | for interpretation. 218 | } 219 | \examples{ 220 | \dontrun{ 221 | library(clusterProfiler) 222 | library(org.Hs.eg.db) 223 | library(enrichplot) 224 | library(GOSemSim) 225 | library(ggplot2) 226 | library(DOSE) 227 | data(geneList) 228 | gene <- names(geneList)[abs(geneList) > 2] 229 | ego <- enrichGO(gene = gene, 230 | universe = names(geneList), 231 | OrgDb = org.Hs.eg.db, 232 | ont = "BP", 233 | pAdjustMethod = "BH", 234 | pvalueCutoff = 0.01, 235 | qvalueCutoff = 0.05, 236 | readable = TRUE) 237 | d <- godata('org.Hs.eg.db', ont="BP") 238 | ego2 <- pairwise_termsim(ego, method = "Wang", semData = d) 239 | treeplot(ego2, showCategory = 30) 240 | # use `hilight = FALSE` to remove ggtree::geom_hilight() layer. 241 | treeplot(ego2, showCategory = 30, hilight = FALSE) 242 | # use `offset` parameter to adjust the distance of bar and tree. 243 | treeplot(ego2, showCategory = 30, hilight = FALSE, offset = rel(1.5)) 244 | # use `offset_tiplab` parameter to adjust the distance of nodes and branches. 245 | treeplot(ego2, showCategory = 30, hilight = FALSE, offset_tiplab = rel(1.5)) 246 | keep <- rownames(ego2@termsim)[c(1:10, 16:20)] 247 | keep 248 | treeplot(ego2, showCategory = keep) 249 | treeplot(ego2, showCategory = 20, 250 | group_color = c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442")) 251 | # It can also graph compareClusterResult 252 | data(gcSample) 253 | xx <- compareCluster(gcSample, fun="enrichKEGG", 254 | organism="hsa", pvalueCutoff=0.05) 255 | xx <- pairwise_termsim(xx) 256 | treeplot(xx) 257 | 258 | # use `geneClusterPanel` to change the gene cluster panel. 259 | treeplot(xx, geneClusterPanel = "dotplot") 260 | 261 | treeplot(xx, geneClusterPanel = "pie") 262 | } 263 | } 264 | -------------------------------------------------------------------------------- /man/upsetplot-methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/upsetplot.R 3 | \docType{methods} 4 | \name{upsetplot} 5 | \alias{upsetplot} 6 | \alias{upsetplot,enrichResult-method} 7 | \alias{upsetplot,enrichResult,ANY-method} 8 | \alias{upsetplot,gseaResult-method} 9 | \alias{upsetplot,gseaResult} 10 | \title{upsetplot method} 11 | \usage{ 12 | upsetplot(x, ...) 13 | 14 | \S4method{upsetplot}{enrichResult}(x, n = 10, ...) 15 | 16 | \S4method{upsetplot}{gseaResult}(x, n = 10, ...) 17 | } 18 | \arguments{ 19 | \item{x}{object} 20 | 21 | \item{...}{additional parameters} 22 | 23 | \item{n}{number of categories to be plotted} 24 | } 25 | \value{ 26 | plot 27 | } 28 | \description{ 29 | upsetplot method generics 30 | } 31 | \examples{ 32 | require(DOSE) 33 | data(geneList) 34 | de=names(geneList)[1:100] 35 | x <- enrichDO(de) 36 | upsetplot(x, 8) 37 | } 38 | \author{ 39 | Guangchuang Yu 40 | } 41 | -------------------------------------------------------------------------------- /man/volplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/AllGenerics.R, R/volplot.R 3 | \name{volplot} 4 | \alias{volplot} 5 | \alias{volplot,enrichResult-method} 6 | \alias{volplot.enrichResult} 7 | \title{volplot} 8 | \usage{ 9 | volplot( 10 | x, 11 | color = "zScore", 12 | xintercept = 1, 13 | yintercept = 2, 14 | showCategory = 5, 15 | label_format = 30, 16 | ... 17 | ) 18 | 19 | \S4method{volplot}{enrichResult}( 20 | x, 21 | color = "zScore", 22 | xintercept = 1, 23 | yintercept = 2, 24 | showCategory = 5, 25 | label_format = 30, 26 | ... 27 | ) 28 | 29 | volplot.enrichResult( 30 | x, 31 | color = "zScore", 32 | xintercept = 1, 33 | yintercept = 2, 34 | showCategory = 5, 35 | label_format = 30, 36 | font.size = 12, 37 | size = 5 38 | ) 39 | } 40 | \arguments{ 41 | \item{x}{enrichment result.} 42 | 43 | \item{color}{selected variable to color the dots} 44 | 45 | \item{xintercept}{value to set x intercept} 46 | 47 | \item{yintercept}{value to set y intercept} 48 | 49 | \item{showCategory}{number of most significant enriched terms or selected terms to 50 | display determined by the variable selected to color the dots} 51 | 52 | \item{label_format}{a numeric value sets wrap length, alternatively a 53 | custom function to format axis labels.} 54 | 55 | \item{...}{Additional parameters} 56 | 57 | \item{font.size}{font size for `theme_dose()`} 58 | 59 | \item{size}{font size to label selected categories specified by showCategory} 60 | } 61 | \value{ 62 | ggplot object 63 | } 64 | \description{ 65 | volcano plot for enrichment result 66 | } 67 | \examples{ 68 | library(DOSE) 69 | data(geneList) 70 | de <- names(geneList)[1:100] 71 | x <- enrichDO(de) 72 | volplot(x) 73 | } 74 | \author{ 75 | Guangchuang Yu 76 | } 77 | -------------------------------------------------------------------------------- /vignettes/enrichplot.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Visualization of Functional Enrichment Result" 3 | author: "\\ 4 | 5 | Guangchuang Yu\\ 6 | 7 | School of Basic Medical Sciences, Southern Medical University" 8 | date: "`r Sys.Date()`" 9 | output: 10 | prettydoc::html_pretty: 11 | toc: true 12 | theme: cayman 13 | highlight: github 14 | pdf_document: 15 | toc: true 16 | vignette: > 17 | %\VignetteEngine{knitr::rmarkdown} 18 | %\VignetteIndexEntry{enrichplot} 19 | %\usepackage[utf8]{inputenc} 20 | --- 21 | 22 | Please go to for the full vignette. --------------------------------------------------------------------------------