├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── Makefile ├── NAMESPACE ├── NEWS.md ├── R ├── axis.R ├── facet_set.R ├── geom-scatter-rect.R ├── geom-volpoint.R ├── geom_cake.R ├── geom_segment_c.R ├── geom_triangle.R ├── get-legend.r ├── ggelement.R ├── ggfun-package.R ├── gglegend.R ├── keybox.R ├── method-ggplot-add.R ├── method-identify.R ├── operator.R ├── reexport.R ├── set_font.R ├── theme.R ├── treedata-function.R ├── utilities.R └── zzz.R ├── inst └── prototype │ └── geom_rtile.r ├── man ├── attacher.Rd ├── element_blinds.Rd ├── element_roundrect.Rd ├── facet_set.Rd ├── geom_cake.Rd ├── geom_scatter_rect.Rd ├── geom_segment_c.Rd ├── geom_triangle.Rd ├── geom_volpoint.Rd ├── get-legend.Rd ├── get_aes_var.Rd ├── get_plot_data.Rd ├── ggbreak2ggplot.Rd ├── ggfun-package.Rd ├── gglegend.Rd ├── ggrange.Rd ├── identify.Rd ├── is-ggbreak.Rd ├── is.ggtree.Rd ├── keybox.Rd ├── reexports.Rd ├── set_font.Rd ├── set_point_legend_shape.Rd ├── td_filter.Rd ├── td_mutate.Rd ├── td_unnest.Rd ├── theme-no-axis.Rd ├── theme_blinds.Rd ├── theme_fp.Rd ├── theme_no_margin.Rd ├── theme_nothing.Rd ├── theme_stamp.Rd ├── theme_transparent.Rd └── volplot.Rd └── vignettes └── ggfun.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | ^CRAN-SUBMISSION$ 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rhistory 2 | CRAN-SUBMISSION 3 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggfun 2 | Title: Miscellaneous Functions for 'ggplot2' 3 | Version: 0.1.9 4 | Authors@R: c( 5 | person("Guangchuang", "Yu", email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0002-6485-8781")), 6 | person("Shuangbin", "Xu", email = "xshuangbin@163.com", role = "aut", comment = c(ORCID="0000-0003-3513-5362")) 7 | ) 8 | Description: Useful functions and utilities for 'ggplot' object (e.g., geometric layers, themes, and utilities to edit the object). 9 | Depends: 10 | R (>= 4.2.0) 11 | Imports: 12 | cli, 13 | dplyr, 14 | ggplot2, 15 | grid, 16 | rlang, 17 | utils, 18 | yulab.utils (>= 0.1.6) 19 | Suggests: 20 | ggplotify, 21 | knitr, 22 | rmarkdown, 23 | prettydoc, 24 | tidyr, 25 | ggnewscale 26 | VignetteBuilder: knitr 27 | ByteCompile: true 28 | License: Artistic-2.0 29 | Encoding: UTF-8 30 | URL: https://github.com/YuLab-SMU/ggfun 31 | BugReports: https://github.com/YuLab-SMU/ggfun/issues 32 | Roxygen: list(markdown = TRUE) 33 | RoxygenNote: 7.3.2 34 | -------------------------------------------------------------------------------- /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 | 5 | all: rd check clean 6 | 7 | alldocs: rd readme mkdocs 8 | 9 | rd: 10 | Rscript -e 'roxygen2::roxygenise(".")' 11 | 12 | readme: 13 | Rscript -e 'rmarkdown::render("README.Rmd")' 14 | 15 | readme2: 16 | Rscript -e 'rmarkdown::render("README.Rmd", "html_document")' 17 | 18 | build: 19 | #cd ..;\ 20 | #R CMD build $(PKGSRC) 21 | Rscript -e 'devtools::build()' 22 | 23 | build2: 24 | cd ..;\ 25 | R CMD build --no-build-vignettes $(PKGSRC) 26 | 27 | install: 28 | cd ..;\ 29 | R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz 30 | 31 | check: 32 | #cd ..;\ 33 | #Rscript -e 'rcmdcheck::rcmdcheck("$(PKGNAME)_$(PKGVERS).tar.gz")' 34 | Rscript -e 'devtools::check()' 35 | 36 | check2: build 37 | cd ..;\ 38 | R CMD check $(PKGNAME)_$(PKGVERS).tar.gz 39 | 40 | bioccheck: 41 | cd ..;\ 42 | Rscript -e 'BiocCheck::BiocCheck("$(PKGNAME)_$(PKGVERS).tar.gz")' 43 | 44 | clean: 45 | cd ..;\ 46 | $(RM) -r $(PKGNAME).Rcheck/ 47 | 48 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("%<+%",ggflow) 4 | S3method("%<+%",ggsc) 5 | S3method("%<+%",ggtangle) 6 | S3method("%<+%",ggtree) 7 | S3method(element_grob,element_blinds) 8 | S3method(element_grob,element_roundrect) 9 | S3method(ggplot_add,facet_set) 10 | S3method(ggplot_add,scatter_rect) 11 | S3method(ggplot_add,segmentC) 12 | S3method(ggplot_add,volpoint) 13 | S3method(identify,gg) 14 | S3method(left_join,ggsc) 15 | export("%<+%") 16 | export(element_blinds) 17 | export(element_roundrect) 18 | export(facet_set) 19 | export(geom_cake) 20 | export(geom_scatter_rect) 21 | export(geom_segment_c) 22 | export(geom_triangle) 23 | export(geom_volpoint) 24 | export(get_aes_var) 25 | export(get_legend) 26 | export(get_plot_data) 27 | export(ggbreak2ggplot) 28 | export(gglegend) 29 | export(ggrange) 30 | export(gpar) 31 | export(identify) 32 | export(is.ggbreak) 33 | export(is.ggtree) 34 | export(keybox) 35 | export(set_font) 36 | export(set_point_legend_shape) 37 | export(td_filter) 38 | export(td_mutate) 39 | export(td_unnest) 40 | export(theme_blinds) 41 | export(theme_fp) 42 | export(theme_no_margin) 43 | export(theme_noaxis) 44 | export(theme_nothing) 45 | export(theme_noxaxis) 46 | export(theme_noyaxis) 47 | export(theme_stamp) 48 | export(theme_transparent) 49 | export(volplot) 50 | export(xrange) 51 | export(yrange) 52 | importFrom(cli,cli_alert) 53 | importFrom(cli,cli_warn) 54 | importFrom(dplyr,left_join) 55 | importFrom(dplyr,rename) 56 | importFrom(ggplot2,"%+replace%") 57 | importFrom(ggplot2,.pt) 58 | importFrom(ggplot2,Geom) 59 | importFrom(ggplot2,Stat) 60 | importFrom(ggplot2,aes) 61 | importFrom(ggplot2,aes_) 62 | importFrom(ggplot2,aes_string) 63 | importFrom(ggplot2,draw_key_blank) 64 | importFrom(ggplot2,element_blank) 65 | importFrom(ggplot2,element_grob) 66 | importFrom(ggplot2,element_line) 67 | importFrom(ggplot2,element_rect) 68 | importFrom(ggplot2,element_text) 69 | importFrom(ggplot2,facet_grid) 70 | importFrom(ggplot2,geom_point) 71 | importFrom(ggplot2,geom_rect) 72 | importFrom(ggplot2,ggplot) 73 | importFrom(ggplot2,ggplotGrob) 74 | importFrom(ggplot2,ggplot_add) 75 | importFrom(ggplot2,ggplot_build) 76 | importFrom(ggplot2,ggplot_gtable) 77 | importFrom(ggplot2,ggproto) 78 | importFrom(ggplot2,guide_legend) 79 | importFrom(ggplot2,guides) 80 | importFrom(ggplot2,last_plot) 81 | importFrom(ggplot2,layer) 82 | importFrom(ggplot2,margin) 83 | importFrom(ggplot2,rel) 84 | importFrom(ggplot2,scale_color_manual) 85 | importFrom(ggplot2,theme) 86 | importFrom(ggplot2,theme_get) 87 | importFrom(ggplot2,theme_void) 88 | importFrom(ggplot2,xlab) 89 | importFrom(graphics,identify) 90 | importFrom(grid,convertX) 91 | importFrom(grid,convertY) 92 | importFrom(grid,dataViewport) 93 | importFrom(grid,editGrob) 94 | importFrom(grid,gList) 95 | importFrom(grid,gPath) 96 | importFrom(grid,gTree) 97 | importFrom(grid,gpar) 98 | importFrom(grid,grid.draw) 99 | importFrom(grid,grid.force) 100 | importFrom(grid,grid.locator) 101 | importFrom(grid,grid.ls) 102 | importFrom(grid,polygonGrob) 103 | importFrom(grid,pushViewport) 104 | importFrom(grid,rectGrob) 105 | importFrom(grid,segmentsGrob) 106 | importFrom(grid,unit) 107 | importFrom(grid,viewport) 108 | importFrom(rlang,.data) 109 | importFrom(rlang,quo_text) 110 | importFrom(utils,modifyList) 111 | importFrom(utils,tail) 112 | importFrom(yulab.utils,yulab_msg) 113 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # ggfun 0.1.9 2 | 3 | + S3 method consistency with ggplot2 (v=4.0.0) (2025-06-21, Sat, #15, #16) 4 | + import `ggplot2::facet_grid()` (2025-03-17, Mon) 5 | 6 | # ggfun 0.1.8 7 | 8 | + `get_aes_var()` compatible with rlang syntax, `.data[[var]]` and `.data$var` (2024-12-03, Tue) 9 | 10 | # ggfun 0.1.7 11 | 12 | + `td_filter()`, `td_mutate()` and `td_unnest()` from the 'ggtree' package (2024-10-24, Thu) 13 | + `%<+%` method for 'ggtangle' object (2024-10-24, Thu) 14 | 15 | # ggfun 0.1.6 16 | 17 | + `%<+%` method for 'ggflow' object (2024-08-28, Wed) 18 | + `geom_scatter_rect()` to draw retangle boxes as scatter points (2024-08-28, Wed) 19 | 20 | # ggfun 0.1.5 21 | 22 | + implement the `%<+%` operator as a S3 method (2024-05-26, Sun) 23 | - mv the `%<+%` operator from 'ggtree' as the `%<+%.ggtree` method 24 | - implement `%<+%.ggsc` method for `ggsc` object. 25 | 26 | # ggfun 0.1.4 27 | 28 | + deprecate `keybox()` as it is not compatible with ggplot2 v3.5.0 and we have better solution by using `element_roundrect()` (2024-01-18, Thu) 29 | + `theme_noaxis()` to remove both x and y axes (2023-12-22, Fri) 30 | 31 | # ggfun 0.1.3 32 | 33 | + `set_point_legend_shape()` to override point shape legend (2023-09-15, Fri) 34 | + `get_plot_data()` to extract data from a 'gg' plot (2023-09-12, Tue) 35 | 36 | # ggfun 0.1.2 37 | 38 | + add R version dependency in DESCRIPTION (2023-08-04, Fri) 39 | + `get_legend()` function to extract legend of a plot (2023-07-10, Mon) 40 | 41 | # ggfun 0.1.1 42 | 43 | + mv `theme_no_margin()` from the 'aplot' package (2023-06-24, Sat) 44 | + mv `theme_fp()` from the 'ggbreak' package (2023-06-24, Sat) 45 | + be compatible with R 4.1 (2023-06-21, Wed, #10) 46 | 47 | # ggfun 0.1.0 48 | 49 | + remove `theme_stamp()` and implement a better version `theme_blinds()` which internally use `element_blinds()` to draw the strip background (2023-06-20, Tue, #9) 50 | + `geom_cake()`, `geom_triangle()` and `geom_segment_c()` functions from 'GuangchuangYu/gglayer' (2023-02-10, Fri) 51 | + `volplot()` function to visualize volcano plot for DEGs (2022-11-29, Tue) 52 | + `geom_volpoint()` for volcano plot (2022-11-28, Mon) 53 | 54 | # ggfun 0.0.9 55 | 56 | + `theme_noxaxis()` (2022-11-21, Mon) 57 | 58 | # ggfun 0.0.8 59 | 60 | + compatible with ggplot2 v3.4.0 (2022-11-07, Mon) 61 | 62 | # ggfun 0.0.7 63 | 64 | + add `theme_stamp` (2022-08-31, Wed, #6) (remove since v=0.1.0, use `theme_blinds` instead) 65 | 66 | # ggfun 0.0.6 67 | 68 | + mv `identify.gg()` from 'ggtree' (2022-04-01, Fri) 69 | + mv `ggrange()`, `xrange()` and `yrange()` from 'aplot' 70 | 71 | # ggfun 0.0.5 72 | 73 | + mv `theme_transparent()` and `theme_nothing()` from the ggimage package (2022-01-20, Thu) 74 | 75 | # ggfun 0.0.4 76 | 77 | + mv `ggbreak2ggplot`, `is.ggbreak` and `is.ggtree` from the aplot package (2021-09-16, Thu) 78 | + `facet_set`: a better implementation of manually setting facet label, which combines `add_facet`, `ggtree::facet_labeller` and more (2021-09-15, Wed) 79 | + `add_facet` to add facet label to a ggplot object (2021-09-03, Fri) 80 | 81 | # ggfun 0.0.3 82 | 83 | + `element_roundrect` to add round rect background to ggplot legend. Now we can use `theme()` to enable this effect (2021-08-10) 84 | 85 | # ggfun 0.0.2 86 | 87 | + mv `gglegend` and `set_font` functions from `yyplot` package (2021-06-30) 88 | + mv `get_aes_var` from `rvcheck` package 89 | 90 | # ggfun 0.0.1 91 | 92 | + `keybox` to add round rect background to ggplot legend (2021-06-29) 93 | 94 | -------------------------------------------------------------------------------- /R/axis.R: -------------------------------------------------------------------------------- 1 | 2 | ##' @rdname ggrange 3 | ##' @export 4 | yrange <- function(gg, type = "limit", region = "panel") { 5 | ggrange(gg, var = "y", type = type, region = region) 6 | } 7 | 8 | ##' @rdname ggrange 9 | ##' @export 10 | xrange <- function(gg, type = "limit", region = "panel") { 11 | ggrange(gg, var = "x", type = type, region = region) 12 | } 13 | 14 | ##' extract x or y ranges of a ggplot 15 | ##' 16 | ##' 17 | ##' @title plot range of a ggplot object 18 | ##' @rdname ggrange 19 | ##' @param gg a ggplot object 20 | ##' @param var either 'x' or 'y' 21 | ##' @param type one of 'limit' or 'range', if 'region == "plot"', 22 | ##' to extract plot limit or plot data range 23 | ##' @param region one of 'panel' or 'plot' to indicate extracting range 24 | ##' based on the plot panel (scale expand will be counted) or 25 | ##' plot data (scale expand will not be counted) 26 | ##' @return range of selected axis 27 | ##' @importFrom ggplot2 ggplot_build 28 | ##' @export 29 | ##' @author Guangchuang Yu 30 | ggrange <- function(gg, var, type = 'limit', region = 'panel') { 31 | ## ## https://github.com/YuLab-SMU/aplot/pull/3 32 | ## ## res <- layer_scales(gg)[[var]]$range$range 33 | ## res <- layer_scales(gg)[[var]]$limits 34 | ## if (is.null(res)) { 35 | ## res <- layer_scales(gg)[[var]]$range$range 36 | ## } 37 | ## if (is.character(res)) return(res) 38 | 39 | ## var <- paste0(var, ".range") 40 | ## ggplot_build(gg)$layout$panel_params[[1]][[var]] 41 | 42 | type <- match.arg(type, c("limit", 'range')) 43 | region <- match.arg(region, c("panel", "plot")) 44 | 45 | ## var <- paste0("panel_scales_", var) 46 | ## x <- ggplot_build(gg)$layout[[var]][[1]] 47 | x <- ggplot_build(gg)$layout[["panel_params"]][[1]] 48 | 49 | if (region == "panel") { 50 | var2 <- paste0(var, ".range") 51 | return(x[[var2]]) 52 | } 53 | 54 | if (type == 'limit') { 55 | res <- x[[var]]$limits 56 | } else { 57 | res <- x[[var]]$scale$range$range 58 | } 59 | 60 | return(res) 61 | } 62 | -------------------------------------------------------------------------------- /R/facet_set.R: -------------------------------------------------------------------------------- 1 | ##' add a facet label to a ggplot or change facet label of a ggplot 2 | ##' 3 | ##' @title facet_set 4 | ##' @param label a character or a named vector to label the plot 5 | ##' @param side to label the plot at which side, either 't' (top) or 'r' (right) 6 | ##' @param angle angle of the facet label. Default is 0 for side='t' and -90 for side='r'. 7 | ##' @return a ggplot with facet label 8 | ##' @export 9 | facet_set <- function(label, side="t", angle = NULL){ 10 | side <- match.arg(side, c('top', 'right')) 11 | 12 | structure(list( 13 | label = label, 14 | side = side, 15 | angle = angle 16 | ), 17 | class = "facet_set" 18 | ) 19 | } 20 | 21 | 22 | ## prototype of facet_set 23 | 24 | ##' add a facet label to a ggplot 25 | ##' 26 | ##' add a facet label to a ggplot which only contains 1 panel 27 | ##' @title add_facet 28 | ##' @param plot a ggplot object 29 | ##' @param label a string to label the plot 30 | ##' @param side to label the plot at which side, either 't' (top) or 'r' (right) 31 | ##' @param angle angle of the facet label. Default is 0 for side='t' and -90 for side='r'. 32 | ##' @return a ggplot with facet label 33 | ##' @importFrom ggplot2 theme 34 | ##' @importFrom ggplot2 margin 35 | ##' @importFrom ggplot2 element_rect 36 | ##' @importFrom ggplot2 element_text 37 | ##' @importFrom ggplot2 rel 38 | ##' @importFrom ggplot2 facet_grid 39 | ##' @noRd 40 | ##' @author Guangchuang Yu 41 | ## add_facet <- function(plot, label, side = 't', angle = NULL) { 42 | ## side <- match.arg(side, c('t', 'r')) 43 | ## lb <- paste0("'", eval(label), "'") 44 | ## if (side == 't') { 45 | ## lb <- paste0('~', lb) 46 | ## } else { 47 | ## lb <- paste0(lb, '~.') 48 | ## if (is.null(angle)) angle <- -90 49 | ## } 50 | 51 | ## plot + facet_grid(eval(parse(text=lb))) + 52 | ## theme(strip.background = element_rect(fill='grey85', colour = NA), 53 | ## strip.text = element_text(colour = 'grey10', 54 | ## size = rel(0.8), 55 | ## angle = angle, 56 | ## margin = margin(4.4, 4.4, 4.4, 4.4)) 57 | ## ) 58 | ## } 59 | 60 | -------------------------------------------------------------------------------- /R/geom-scatter-rect.R: -------------------------------------------------------------------------------- 1 | #' draw rectangle boxes as scatter points 2 | #' 3 | #' @title geom_scatter_rect 4 | #' @param mapping aesthetic mapping, default is NULL 5 | #' @param data input data, default is NULL 6 | #' @param asp aspect ration of rectangle box (height vs width), only works for height is missing 7 | #' @param width width of the rectangles, default is 0.8 8 | #' @param height height of the rectangles 9 | #' @param ... additional parameters passed to 'geom_rect' 10 | #' @importFrom ggplot2 geom_rect 11 | #' @importFrom rlang .data 12 | #' @export 13 | #' @author Guangchuang Yu 14 | geom_scatter_rect <- function( 15 | mapping = NULL, 16 | data = NULL, 17 | asp = .6, 18 | width = .8, 19 | height = NULL, 20 | ...) { 21 | 22 | # mostly, it equivalent to geom_tile 23 | 24 | params <- list(...) 25 | 26 | structure( 27 | list( 28 | data = data, 29 | mapping = mapping, 30 | asp = asp, 31 | width = width, 32 | height = height, 33 | params = params 34 | ), 35 | class = 'scatter_rect' 36 | ) 37 | } 38 | 39 | 40 | #rect <- function(data, coords) { 41 | # gp <- gpar() 42 | # if (!is.null(data$fill)) { 43 | # gp <- modifyList(gp, list(fill=adjustcolor(data$fill))) 44 | # } 45 | # rectGrob( 46 | # coords$x, 47 | # coords$y, 48 | # width = .5, 49 | # height = .5, 50 | # gp = gp) 51 | #} 52 | # 53 | #ggplot(d, aes(x, y)) + grid_panel(rect, aes(fill=x)) 54 | 55 | 56 | ##' @importFrom ggplot2 ggplot_add 57 | ##' @method ggplot_add scatter_rect 58 | ##' @importFrom utils modifyList 59 | ##' @importFrom ggplot2 aes 60 | ##' @export 61 | ggplot_add.scatter_rect <- function(object, plot, object_name, ...) { 62 | w <- object$width 63 | if (is.null(object$height)) { 64 | h <- w * object$asp 65 | } else { 66 | h <- object$height 67 | } 68 | 69 | w <- w/2 70 | h <- h/2 71 | 72 | x <- get_aes_var(plot$mapping, 'x') 73 | y <- get_aes_var(plot$mapping, 'y') 74 | default_mapping <- aes(xmin = .data[[x]] - w, xmax = .data[[x]] + w, 75 | ymin = .data[[y]] - h, ymax = .data[[y]] + h) 76 | 77 | if (!is.null(object$mapping)) { 78 | mapping <- modifyList(default_mapping, object$mapping) 79 | } else { 80 | mapping <- default_mapping 81 | } 82 | 83 | params <- object$params 84 | params$mapping <- mapping 85 | params$data <- object$data 86 | 87 | ly <- do.call("geom_rect", params) 88 | ggplot_add(ly, plot, object_name, ...) 89 | } 90 | 91 | -------------------------------------------------------------------------------- /R/geom-volpoint.R: -------------------------------------------------------------------------------- 1 | ##' layer of scatter points for volcano plot to visualize differential genes 2 | ##' 3 | ##' @title geom_volpoint 4 | ##' @param mapping aesthetic mapping 5 | ##' @param data input data set 6 | ##' @param log2FC_cutoff cutoff values for log2FC 7 | ##' @param p_cutoff cutoff values p-value or adjusted p-value 8 | ##' @param ... additional paramters passed to the layer 9 | ##' @return a ggplot 10 | ##' @export 11 | geom_volpoint <- function(mapping = NULL, data = NULL, log2FC_cutoff = 2, p_cutoff = 1e-05, ...) { 12 | structure(list(mapping = mapping, 13 | data = data, 14 | log2FC_cutoff = log2FC_cutoff, 15 | p_cutoff = p_cutoff, 16 | ...), 17 | class = "volpoint") 18 | } 19 | 20 | ##' volcano plot 21 | ##' 22 | ##' @title volplot 23 | ##' @param data input data set 24 | ##' @param mapping aesthetic mapping 25 | ##' @param log2FC_cutoff cutoff values for log2FC 26 | ##' @param p_cutoff cutoff values p-value or adjusted p-value 27 | ##' @param ... additional paramters passed to the 'geom_volpoint' layer 28 | ##' @return a ggplot 29 | ##' @importFrom ggplot2 ggplot 30 | ##' @importFrom ggplot2 scale_color_manual 31 | ##' @importFrom ggplot2 xlab 32 | ##' @export 33 | volplot <- function(data, mapping, log2FC_cutoff = 2, p_cutoff = 1e-05, ...) { 34 | yvar <- ggfun::get_aes_var(mapping, 'y') 35 | if (grepl("adj", yvar)) { # use adjusted p value 36 | ylab <- bquote(~Log[2] ~ italic(P[adj])) 37 | siglab <- bquote(~Log[2] ~ "FC & " ~-Log[10] ~ italic(P[adj])) 38 | } else { 39 | ylab <- bquote(~Log[2] ~ italic(P)) 40 | siglab <- bquote(~Log[2] ~ "FC & " ~-Log[10] ~ italic(P)) 41 | } 42 | 43 | ggplot(data, mapping) + 44 | geom_volpoint(log2FC_cutoff =log2FC_cutoff, p_cutoff = p_cutoff) + 45 | scale_color_manual(values=c("red2", "royalblue", "forestgreen", "grey30"), 46 | labels = c(siglab, ylab, bquote(~Log[2] ~ "FC"), "NS"), 47 | name="") + 48 | xlab(bquote(~Log[2] ~ "Fold Change")) + 49 | ylab(ylab) 50 | } 51 | -------------------------------------------------------------------------------- /R/geom_cake.R: -------------------------------------------------------------------------------- 1 | ##' @importFrom grid gList 2 | ##' @importFrom grid rectGrob 3 | ##' @importFrom grid polygonGrob 4 | ##' @importFrom grid gpar 5 | candleGrob <- function(x, y, colour.candle = "orange", colour.fire = "red", vp=NULL) { 6 | width <- 0.02 7 | height <- 0.2 8 | 9 | xx = c(x+.005,x-.01,x+.01,x+.03,x+.015,x+0.005) 10 | yy = c(y+.2,y+.23,y+.26,y+.23,y+.2,y+.2) 11 | 12 | gTree(children = gList( 13 | rectGrob(x+width/2, y+height/2, width = width, height = height, gp = gpar(fill=colour.candle), vp=vp), 14 | polygonGrob(xx, yy, gp = gpar(fill = colour.fire), vp=vp) 15 | )) 16 | } 17 | 18 | ellipseGrob <- function(x, y, a, b, gp=gpar(), vp=NULL) { 19 | t <- seq(0, 2*pi, length.out=100) 20 | xx <- x + a * cos(t) 21 | yy <- y + b * sin(t) 22 | polygonGrob(xx, yy, gp = gp, vp=vp) 23 | } 24 | 25 | ##' @author Guangchuang Yu 26 | ##' @importFrom grid segmentsGrob 27 | cakeGrob <- function(x=.5, y=.5, a=.4, b=.14, A=.44, B=.17, height=.3, gp=gpar(), vp=NULL) { 28 | gp2 <- gp 29 | if (!is.null(gp$fill)) { 30 | gp2$col <- gp2$fill 31 | } 32 | gTree(children = gList( 33 | ellipseGrob(x, y-height, A, B, gp=gp, vp=vp), 34 | ellipseGrob(x, y-height, a, b, gp=gp, vp=vp), 35 | rectGrob(x, y-height/2, a*2, height, gp=gp2, vp=vp), 36 | segmentsGrob(x-a, y-height, x-a, y, gp=gp, vp=vp), 37 | segmentsGrob(x+a, y-height, x+a, y, gp=gp, vp=vp), 38 | ellipseGrob(x, y, a, b, gp=gp, vp=vp)) 39 | ) 40 | } 41 | 42 | 43 | ##' @importFrom grid gTree 44 | cakeCandleGrob <- function(colour.cake = "pink", colour.candle="orange", colour.fire="red", vp=NULL, name=NULL) { 45 | grobs <- gList(cakeGrob(x=.5, y=.5, a=.4, b=.14, A=.44, B=.17, height=.3, gp=gpar(fill=colour.cake)), 46 | candleGrob(.25,.45, colour.candle, colour.fire), 47 | candleGrob(.3,.5, colour.candle, colour.fire), 48 | candleGrob(.4, .45,colour.candle, colour.fire), 49 | candleGrob(.5,.5, colour.candle, colour.fire), 50 | candleGrob(.6, .45, colour.candle, colour.fire), 51 | candleGrob(.7, .52, colour.candle, colour.fire) 52 | ) 53 | gTree(children=grobs, name=name, vp=vp) 54 | } 55 | 56 | 57 | ##' ggplot2 layer of birthday cake 58 | ##' 59 | ##' 60 | ##' @title geom_cake 61 | ##' @param mapping aes mapping 62 | ##' @param data data 63 | ##' @param ... additional parameters 64 | ##' @return ggplot2 layer 65 | ##' @importFrom ggplot2 layer 66 | ##' @export 67 | ##' @examples 68 | ##' library(ggplot2) 69 | ##' ggplot(mtcars, aes(mpg, disp)) + geom_cake() 70 | ##' @author Guangchuang Yu 71 | ##' @examples 72 | ##' library(ggplot2) 73 | ##' ggplot(mtcars, aes(mpg, disp)) + geom_cake() 74 | geom_cake <- function(mapping = NULL, data = NULL, ...) { 75 | layer( 76 | data = data, 77 | mapping = mapping, 78 | geom = GeomCake, 79 | stat = "identity", 80 | position = "identity", 81 | params = list(...), 82 | check.aes = FALSE 83 | ) 84 | } 85 | 86 | ##' @importFrom grid viewport 87 | ##' @importFrom ggplot2 ggproto 88 | ##' @importFrom ggplot2 Geom 89 | ##' @importFrom ggplot2 draw_key_blank 90 | ##' @importFrom ggplot2 aes 91 | GeomCake <- ggproto("GeomCake", Geom, 92 | draw_panel = function(data, panel_scales, coord) { 93 | data <- coord$transform(data, panel_scales) 94 | 95 | grobs <- lapply(1:nrow(data), function(i) { 96 | vp <- viewport(x=data$x[i], y=data$y[i], 97 | width=data$size[i], height=data$size[i], 98 | angle = data$angle[i], 99 | just = c("center", "center"), 100 | default.units = "native") 101 | cakeCandleGrob(data$colour.cake[i], data$colour.candle[i], data$colour.fire[i], vp=vp, name=i) 102 | }) 103 | class(grobs) <- "gList" 104 | ggplot2:::ggname("geom_cake", 105 | gTree(children = grobs)) 106 | }, 107 | non_missing_aes = c("x", "y", "size", "colour.cake", "colour.candle", "colour.fire"), 108 | default_aes = aes(size=.1, colour.cake="#FF3399", colour.candle = "orange", colour.fire="red", angle=0), 109 | draw_key = draw_key_blank 110 | ) 111 | 112 | 113 | -------------------------------------------------------------------------------- /R/geom_segment_c.R: -------------------------------------------------------------------------------- 1 | ##' geom_segment_c supports coloring segment with continuous colors 2 | ##' 3 | ##' 4 | ##' @title geom_segment_c 5 | ##' @param mapping aes mapping 6 | ##' @param data data 7 | ##' @param position position 8 | ##' @param lineend lineend 9 | ##' @param na.rm logical 10 | ##' @param show.legend logical 11 | ##' @param inherit.aes logical 12 | ##' @param arrow specification for arrow heads, as created by arrow(). 13 | ##' @param arrow.fill fill color to usse for the arrow head (if closed). `NULL` means use `colour` aesthetic. 14 | ##' @param ... additional parameter 15 | ##' @importFrom ggplot2 layer 16 | ##' @export 17 | ##' @seealso 18 | ##' \link[ggplot2]{geom_segment} 19 | ##' @return add segment layer 20 | ##' @examples 21 | ##' set.seed(2019-06-28) 22 | ##' d = data.frame(x = rnorm(10), 23 | ##' xend = rnorm(10), 24 | ##' y = rnorm(10), 25 | ##' yend = rnorm(10), 26 | ##' v1 = rnorm(10), 27 | ##' v2 = rnorm(10)) 28 | ##' library(ggplot2) 29 | ##' ggplot(d) + geom_segment_c(aes(x = x, xend = xend, y=y, yend =yend, col0 = v1, col1 = v2)) + 30 | ##' scale_color_viridis_c(name = "continuous colored lines") + 31 | ##' theme_minimal() + theme(legend.position=c(.2, .85)) + xlab(NULL) + ylab(NULL) 32 | ##' @author Guangchuang Yu 33 | geom_segment_c <- function(mapping = NULL, data = NULL, 34 | position = 'identity', lineend = "butt", 35 | na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, 36 | arrow = NULL, arrow.fill = NULL, 37 | ...) { 38 | 39 | structure(list( 40 | data = data, 41 | mapping = mapping, 42 | position = position, 43 | show.legend = show.legend, 44 | inherit.aes = inherit.aes, 45 | params = list( 46 | arrow = arrow, 47 | lineend = lineend, 48 | na.rm = na.rm, 49 | ... 50 | ) 51 | ), class = "segmentC") 52 | } 53 | 54 | Stat <- getFromNamespace("Stat", "ggplot2") 55 | 56 | ##' @importFrom ggplot2 ggplot_add 57 | ##' @importFrom ggplot2 aes_string 58 | ##' @method ggplot_add segmentC 59 | ##' @export 60 | ggplot_add.segmentC <- function(object, plot, object_name, ...) { 61 | if (object$inherit.aes) { 62 | mapping <- modifyList(plot$mapping, object$mapping) 63 | } else { 64 | mapping <- object$mapping 65 | } 66 | 67 | v <- get_aes_var(mapping, "col1") 68 | 69 | mapping <- object$mapping 70 | # mapping["colour"] <- list(v) 71 | 72 | default_aes <- aes_string(colour=v) 73 | if (is.null(mapping)) { 74 | mapping <- default_aes 75 | } else { 76 | mapping <- modifyList(mapping, default_aes) 77 | } 78 | 79 | ly <- layer( 80 | data = object$data, 81 | mapping = mapping, 82 | stat = StatSegmentC, 83 | geom = "segment", 84 | position = object$position, 85 | show.legend = object$show.legend, 86 | inherit.aes = object$inherit.aes, 87 | params = object$params, 88 | check.aes = FALSE 89 | ) 90 | 91 | ggplot_add(ly, plot, object_name, ...) 92 | } 93 | 94 | ##' @importFrom ggplot2 Stat 95 | StatSegmentC <- ggproto("StatSegmentC", Stat, 96 | required_aes = c("x", "y", "xend", "yend", "col0", "col1"), 97 | compute_group = function(data, params) { 98 | data 99 | }, 100 | compute_panel = function(self, data, scales, params, lineend, extend = 0.002) { 101 | setup_data_continuous_color_df(data, nsplit = 20, extend = extend) 102 | } 103 | ) 104 | 105 | 106 | 107 | 108 | 109 | setup_data_continuous_color_df <- function(df, nsplit = 100, extend = 0.002, pool = FALSE) { 110 | if (pool) { 111 | rr <- range(df$x) 112 | if (nrow(df) == 1) 113 | rr <- c(df$x, df$xend) 114 | } 115 | 116 | lapply(1:nrow(df), function(i) { 117 | if (!pool) 118 | rr <- c(df$x[i], df$xend[i]) 119 | df2 <- setup_data_continuous_color(x = df$x[i], 120 | xend = df$xend[i], 121 | y = df$y[i], 122 | yend = df$yend[i], 123 | col = df$col0[i], 124 | col2 = df$col1[i], 125 | xrange = rr, 126 | nsplit = nsplit, 127 | extend = extend) 128 | 129 | res <- lapply(df[i,, drop = FALSE], rep, each = nrow(df2)) |> 130 | do.call('cbind', args = list()) |> as.data.frame() 131 | res$x <- df2$x 132 | res$xend <- df2$xend 133 | res$y <- df2$y 134 | res$yend <- df2$yend 135 | res$colour <- df2$col 136 | return(res) 137 | }) |> do.call('rbind', args = list()) 138 | } 139 | 140 | 141 | ## setup_data_continuous_color <- getFromNamespace("setup_data_continuous_color", "ggtree") 142 | 143 | 144 | setup_data_continuous_color <- function(x, xend, y, yend, col, col2, 145 | xrange = NULL, nsplit = 100, extend = 0.002) { 146 | if (is.null(xrange)) 147 | xrange <- c(x, xend) 148 | 149 | ## xstep <- diff(xrange)/nsplit 150 | ## xn <- floor((xend - x)/xstep) 151 | xn <- floor((xend - x) * nsplit /diff(xrange)) 152 | ## slope <- (yend - y)/(xend - x) 153 | ydiff <- yend - y 154 | xdiff <- xend - x 155 | 156 | if (xn > 0) { 157 | ## x <- x + 0:xn * xstep 158 | x <- x + 0:xn * diff(xrange) / nsplit 159 | tmp <- x[-1] * (1 + extend) 160 | tmp[tmp > xend] <- xend 161 | xend <- c(tmp, xend) 162 | ## y <- y + 0:xn * xstep * slope 163 | y <- y + 0:xn * diff(xrange) * ydiff / (nsplit * xdiff) 164 | ## yend <- y + (xend - x) * slope 165 | yend <- y + (xend - x) * ydiff / xdiff 166 | } 167 | 168 | n <- length(x) 169 | if (is.numeric(col) && is.numeric(col2)) { 170 | colour <- seq(col, col2, length.out = n) 171 | } else if (is.character(col) && is.character(col2)) { 172 | colour <- grDevices::colorRampPalette(c(col, col2))(n) 173 | } else { 174 | stop("col and col2 should be both numeric or character..." ) 175 | } 176 | 177 | data.frame(x = x, 178 | xend = xend, 179 | y = y, 180 | yend = yend, 181 | colour = colour) 182 | } 183 | 184 | 185 | -------------------------------------------------------------------------------- /R/geom_triangle.R: -------------------------------------------------------------------------------- 1 | 2 | ##' @importFrom grid polygonGrob 3 | ##' @importFrom grid gpar 4 | 5 | triangleGrob <- function(fill="red",col=NULL,slash="up",alpha=NULL, vp=NULL, name=NULL,...) { 6 | if(slash=="up"){ 7 | x = c(0,0,1) 8 | y = c(0,1,1) 9 | } else if(slash=="down"){ 10 | x = c(0,1,1) 11 | y = c(1,1,0) 12 | } 13 | polygonGrob(x,y, name=name, vp=vp, 14 | gp =gpar(fill=fill, 15 | col=col, 16 | alpha=alpha)) 17 | } 18 | 19 | 20 | ##' ggplot2 layer of triangle 21 | ##' 22 | ##' 23 | ##' @title geom_triangle 24 | ##' @param mapping aes mapping 25 | ##' @param data data 26 | ##' @param ... additional parameters 27 | ##' @return ggplot2 layer 28 | ##' @importFrom ggplot2 layer 29 | ##' @export 30 | ##' @examples 31 | ##' library(ggplot2) 32 | ##' ggplot(mtcars, aes(mpg, disp)) + geom_triangle() 33 | ##' @author Shipeng Guo 34 | geom_triangle <- function(mapping = NULL, data = NULL, ...) { 35 | layer( 36 | data = data, 37 | mapping = mapping, 38 | stat = "identity", 39 | geom = GeomTriangle, 40 | position = "identity", 41 | params = list(...) 42 | ) 43 | } 44 | 45 | ##' @importFrom grid viewport 46 | ##' @importFrom ggplot2 ggproto 47 | ##' @importFrom ggplot2 Geom 48 | ##' @importFrom ggplot2 draw_key_blank 49 | ##' @importFrom ggplot2 aes 50 | GeomTriangle <- ggproto("GeomTriangle", Geom, 51 | draw_panel = function(data, panel_params, coord,slash="up") { 52 | data <- coord$transform(data, panel_params) 53 | data$size <- data$size/100 54 | 55 | grobs <- lapply(1:nrow(data), function(i) { 56 | vp <- viewport(x=data$x[i], y=data$y[i], 57 | width=data$size[i], height=data$size[i], 58 | angle = data$angle[i], 59 | just = c("center", "center"), 60 | default.units = "native") 61 | triangleGrob(vp=vp, 62 | name=i, 63 | fill = data$fill[i], 64 | col = data$colour[i], 65 | alpha = data$alpha[i], 66 | slash=slash) 67 | }) 68 | class(grobs) <- "gList" 69 | ggplot2:::ggname("geom_triangle",gTree(children = grobs)) 70 | }, 71 | 72 | default_aes = aes(colour = NA,fill="red", size = 9, linetype = 1, 73 | alpha = 1,angle=0,slash="up"), 74 | required_aes = c("x", "y"), 75 | draw_key = draw_key_blank 76 | ) 77 | -------------------------------------------------------------------------------- /R/get-legend.r: -------------------------------------------------------------------------------- 1 | ##' extract legend from a plot 2 | ##' 3 | ##' 4 | ##' @title get_legend 5 | ##' @rdname get-legend 6 | ##' @param plot a gg or gtable object 7 | ##' @return a 'gtable' object of the legend 8 | ##' @importFrom ggplot2 ggplot_gtable 9 | ##' @importFrom ggplot2 ggplot_build 10 | ##' @export 11 | ##' @author Guangchuang Yu 12 | get_legend <- function(plot) { 13 | if (inherits(plot, 'gg')) { 14 | gt <- ggplot_gtable(ggplot_build(plot)) 15 | } else { 16 | ## as.grob <- yulab.utils::get_fun_from_pkg('ggplotify', 'as.grob') 17 | gt <- ggplotify::as.grob(plot) 18 | } 19 | gname <- vapply(gt$grobs, function(x) x$name, FUN.VALUE = character(1)) 20 | idx <- which(gname == "guide-box") 21 | legend <- gt$grobs[[idx]] 22 | return(legend) 23 | } 24 | -------------------------------------------------------------------------------- /R/ggelement.R: -------------------------------------------------------------------------------- 1 | #' round rectangle borders and backgrounds 2 | #' @inheritParams ggplot2::element_rect 3 | #' @param linewidth Line/border size in mm 4 | #' @param linetype Line type for lines and borders respectively. An 5 | #' integer (0:8), a name (blank, solid, dashed, dotted, dotdash, 6 | #' longdash, twodash), or a string with an even number (up to eight) 7 | #' of hexadecimal digits which give the lengths in consecutive positions 8 | #' in the string. 9 | #' @param r the radius of the rounded corners, a \code{unit} object, 10 | #' default is unit(0.1, 'snpc'). 11 | #' @export 12 | #' @examples 13 | #' library(ggplot2) 14 | #' p <- ggplot(mpg, aes(displ, cty)) + geom_point() 15 | #' p <- p + facet_grid(cols = vars(cyl)) 16 | #' p <- p + theme(strip.background=element_roundrect(fill="grey40", color=NA, r=0.15)) 17 | #' p 18 | #' p2 <- ggplot(mtcars, aes(mpg, disp, color=factor(cyl), size=cyl)) + 19 | #' geom_point() 20 | #' p2 + theme(legend.background=element_roundrect(color="#808080", linetype=2)) 21 | element_roundrect <- function(fill = NULL, colour = NULL, linewidth = NULL, 22 | linetype = NULL, color = NULL, r=grid::unit(0.1, "snpc"), inherit.blank = FALSE) { 23 | if (!is.null(color)) colour <- color 24 | if (!grid::is.unit(r)) r <- grid::unit(r, 'snpc') 25 | 26 | structure( 27 | list(fill = fill, 28 | colour = colour, 29 | linewidth = linewidth, 30 | linetype = linetype, 31 | r = r, 32 | inherit.blank = inherit.blank), 33 | class = c("element_roundrect", "element_rect", "element") 34 | ) 35 | } 36 | 37 | #' @importFrom ggplot2 element_grob 38 | #' @method element_grob element_roundrect 39 | #' @export 40 | element_grob.element_roundrect <- function(element, 41 | x = 0.5, y = 0.5, width = 1, height = 1, 42 | fill = NULL, colour = NULL, linewidth = NULL, linetype = NULL, 43 | ...) { 44 | 45 | gp <- grid::gpar(lwd = len0_null(linewidth * .pt), 46 | col = colour, 47 | fill = fill, 48 | lty = linetype 49 | ) 50 | element_gp <- grid::gpar(lwd = len0_null(element$linewidth * .pt), 51 | col = element$colour, 52 | fill = element$fill, 53 | lty = element$linetype 54 | ) 55 | 56 | grid::roundrectGrob(x, y, width, height, r = element$r, gp = modify_list(element_gp, gp), ...) 57 | } 58 | 59 | 60 | #' this element is used to control the line color of panel.grid.major/minor.x 61 | #' or panel.grid.major/minor.y 62 | #' @param colour the colour of rectangular, default is c('white', 'grey60'). 63 | #' @param axis character, require, option is \code{y} or \code{x}. 64 | #' @param color, Color is an alias for colour 65 | #' @param inherit.blank Should this element inherit the existence of an 66 | #' \code{element_blank} among its parents? If \code{TRUE} the existence of 67 | #' a blank element among its parents will cause this element to be blank as 68 | #' well. If \code{FALSE} any blank parent element will be ignored when 69 | #' calculating final element state. 70 | #' @export 71 | #' @examples 72 | #' library(ggplot2) 73 | #' df <- data.frame( 74 | #' x = rep(c(2, 5, 7, 9, 12), 2), 75 | #' y = rep(c(1, 2), each = 5), 76 | #' z = factor(rep(1:5, each = 2)), 77 | #' w = rep(diff(c(0, 4, 6, 8, 10, 14)), 2) 78 | #' ) 79 | #' ggplot(df, aes(x, y)) + geom_tile(aes(fill = z), colour = 'grey50') + 80 | #' theme(panel.grid.major.y = element_blinds(color= c('white', 'grey'), axis='y')) 81 | element_blinds <- function(colour = c('white', 'grey60'), 82 | axis, 83 | color = NULL, 84 | inherit.blank = FALSE){ 85 | if (missing(axis)){ 86 | 87 | } 88 | if (!is.null(color)) colour <- color 89 | structure( 90 | list( 91 | colour = colour, 92 | axis = axis, 93 | inherit.blank = inherit.blank), 94 | class = c("element_blinds", "element_line", "element") 95 | ) 96 | } 97 | 98 | #' @importFrom grid gpar polygonGrob 99 | #' @method element_grob element_blinds 100 | #' @export 101 | element_grob.element_blinds <- function(element, x = 0:1, y = 0:1, 102 | colour = NULL, 103 | default.units = "npc", 104 | id.lengths = NULL, 105 | ...){ 106 | gp <- gpar( 107 | col = colour 108 | ) 109 | element_gp <- gpar( 110 | col = element$colour, 111 | fill = element$colour 112 | ) 113 | 114 | xy.coord <- .convert_line_to_poly_coord(x, y, element$axis) 115 | x <- xy.coord$x 116 | y <- xy.coord$y 117 | 118 | id.lengths <- rep(4, length(id.lengths)) 119 | 120 | polygonGrob( 121 | x, y, default.units = default.units, 122 | gp = modify_list(element_gp, gp), 123 | id.lengths = id.lengths, ... 124 | ) 125 | 126 | } 127 | 128 | .convert_line_to_poly_coord <- function(x, y, axis){ 129 | if (axis == 'x'){ 130 | tmp <- x 131 | x <- y 132 | y <- tmp 133 | } 134 | 135 | x <- rep(x, each = 2) 136 | tmp.range <- max(diff(y)) / 2 137 | y <- rep(y, each = 2) 138 | y <- y + rep(c(-1, 1, 1, -1) * tmp.range, length(x)/4) 139 | y[y < 0] <- 0 140 | y[y > 1] <- 1 141 | 142 | if (axis == 'x'){ 143 | tmp <- x 144 | x <- y 145 | y <- tmp 146 | } 147 | return(list(x = x, y = y)) 148 | } 149 | 150 | len0_null <- function (x){ 151 | if (length(x) == 0) 152 | NULL 153 | else x 154 | } 155 | 156 | modify_list <- function (old, new){ 157 | for (i in names(new)) old[[i]] <- new[[i]] 158 | old 159 | } 160 | -------------------------------------------------------------------------------- /R/ggfun-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | -------------------------------------------------------------------------------- /R/gglegend.R: -------------------------------------------------------------------------------- 1 | ##' add manual setting legend 2 | ##' 3 | ##' add additional legend to a ggplot 4 | ##' @title gglegend 5 | ##' @param mapping aes mapping for the 'geom'. The first mapping should be the one for the legend, 6 | ##' while others maybe needed for the 'geom' (e.g., label for geom_text). 7 | ##' @param data input data frame. If users want to mapping 'VALUE' to 'colour', 8 | ##' the input data should contains 'VALUE' and 'colour' (actual value, e.g., 'red' and 'blue') variable. 9 | ##' @param geom a geom to plot the data for generating the legend and the geom will be plotted invisible. 10 | ##' @param p a ggplot object. If NULL, the 'last_plot()' will be used. 11 | ##' @return a ggplot object 12 | ##' @importFrom utils modifyList 13 | ##' @importFrom grid grid.draw 14 | ##' @importFrom ggplot2 guides 15 | ##' @importFrom ggplot2 guide_legend 16 | ##' @export 17 | ##' @examples 18 | ##' library(ggplot2) 19 | ##' p <- ggplot(mtcars, aes(mpg, disp)) + geom_point() 20 | ##' data <- data.frame(colour = c("red", "blue"), VALUE = c("A", "B")) 21 | ##' gglegend(aes(colour = VALUE, label=VALUE), data, geom_text, p) 22 | ##' @author Guangchuang Yu 23 | gglegend <- function(mapping, data, geom, p = NULL) { 24 | if (is.null(p)) p <- ggplot2::last_plot() 25 | 26 | xvar <- get_aes_var(p$mapping, 'x') 27 | yvar <- get_aes_var(p$mapping, 'y') 28 | 29 | 30 | dd <- cbind(data, p$data[1:nrow(data), c(xvar, yvar)]) 31 | m <- names(mapping[1]) 32 | 33 | var <- data[[m]] 34 | names(var) <- data[[get_aes_var(mapping,m)]] 35 | 36 | a <- list(var, alpha = 1) 37 | names(a)[1] <- m 38 | leg <- guide_legend(override.aes=a) 39 | gleg <- list(1) 40 | names(gleg) <- m 41 | gleg[[1]] <- leg 42 | gleg <- do.call(guides, gleg) 43 | 44 | mapping <- modifyList(mapping, p$mapping[c('x', 'y')]) 45 | p + geom(mapping, dd, alpha=0) + gleg 46 | } 47 | 48 | 49 | -------------------------------------------------------------------------------- /R/keybox.R: -------------------------------------------------------------------------------- 1 | ##' draw border for each of the ggplot legends 2 | ##' 3 | ##' 4 | ##' @title keybox 5 | ##' @param p a ggplot object 6 | ##' @param grob one of 'rect' or 'roundrect' 7 | ##' @param gp graphic parameter 8 | ##' @return grob object 9 | ##' @export 10 | ##' @examples 11 | ##' library(ggplot2) 12 | ##' p <- ggplot(mtcars, aes(mpg, disp, color=factor(cyl), size=cyl)) + geom_point() 13 | ##' keybox(p, 'roundrect', gp = gpar(col = '#808080', lty = "dashed")) 14 | ##' @author Guangchuang Yu 15 | keybox <- function(p, grob="roundrect", gp=NULL) { 16 | warning("This function is deprecated, please refer to 'element_roundrect'.") 17 | p + theme(legend.background = element_roundrect(colour = gp$col, linetype = gp$lty)) 18 | # g <- ggplot2::ggplotGrob(p) 19 | # i <- grep("guide-box", g$layout$name) 20 | # g2 <- g$grob[[i]] 21 | # for (j in seq_along(g2)) { 22 | # x <- g2[[1]][[j]] 23 | # if (inherits(x, 'zeroGrob')) next 24 | # if (grob == "rect") { 25 | # gr <- grid::rectGrob 26 | # } else if (grob == "roundrect") { 27 | # gr <- grid::roundrectGrob 28 | # } else { 29 | # stop("grob not supported...") 30 | # } 31 | 32 | # x[[1]][[1]] <- gr(gp = gp) 33 | # g2[[1]][[j]] <- x 34 | # } 35 | # g[[1]][[i]] <- g2 36 | # grid::grid.draw(g) 37 | # invisible(g) 38 | } 39 | -------------------------------------------------------------------------------- /R/method-ggplot-add.R: -------------------------------------------------------------------------------- 1 | #' @importFrom ggplot2 ggplot_add 2 | #' @method ggplot_add facet_set 3 | #' @export 4 | ggplot_add.facet_set <- function(object, plot, object_name, ...){ 5 | if (object$side == 'right' && is.null(object$angle)) { 6 | object$angle <- -90 7 | } 8 | plot <- build_new_plot(object=object, plot=plot) 9 | return(plot) 10 | } 11 | 12 | 13 | #' @method ggplot_add volpoint 14 | #' @importFrom rlang .data 15 | #' @importFrom ggplot2 geom_point 16 | #' @export 17 | ggplot_add.volpoint <- function(object, plot, object_name, ...) { 18 | d <- plot$data 19 | fc_cutoff <- object$log2FC_cutoff 20 | p_cutoff <- object$p_cutoff 21 | 22 | if (is.null(object$data)) { 23 | d$.type = "NS" 24 | xvar <- ggfun::get_aes_var(plot$mapping, 'x') 25 | yvar <- ggfun::get_aes_var(plot$mapping, 'y') 26 | 27 | d$.type[abs(d[[xvar]]) > fc_cutoff] <- xvar 28 | 29 | if (grepl('\\(', yvar)) { 30 | e <- list2env(d) 31 | d$.y <- eval(parse(text = yvar), envir = e) 32 | cutoff <- sub('(.*)\\((.*)\\)', paste0("\\1(", p_cutoff, ")") , yvar) 33 | cutoff <- eval(parse(text=cutoff)) 34 | d$.type[d$.y > cutoff] <- yvar 35 | d$.type[abs(d[[xvar]]) > fc_cutoff & d$.y > cutoff] <- paste(xvar, 'and', yvar) 36 | } else { 37 | d$.y <- d[[yvar]] 38 | d$.type[d$.y < p_cutoff] <- yvar 39 | d$.type[abs(d[[xvar]]) > fc_cutoff & d$.y < p_cutoff] <- paste(xvar, 'and', yvar) 40 | } 41 | 42 | d$.type <- factor(d$.type, levels = c(paste(xvar, 'and', yvar), 43 | yvar, xvar, 'NS')) 44 | 45 | default_mapping <- aes(y = .data$.y, color = .data$.type) 46 | if (is.null(object$mapping)) { 47 | mapping <- default_mapping 48 | } else { 49 | mapping <- object$mapping 50 | } 51 | } else { 52 | d <- object$data 53 | mapping <- object$mapping 54 | } 55 | 56 | object$mapping <- mapping 57 | object$data <- d 58 | object$log2FC_cutoff <- NULL 59 | object$p_cutoff <- NULL 60 | vol_layer <- do.call(geom_point, object) 61 | plot + vol_layer 62 | } 63 | 64 | 65 | ##' @importFrom ggplot2 element_text 66 | ##' @importFrom ggplot2 margin 67 | ##' @importFrom ggplot2 rel 68 | ##' @importFrom ggplot2 facet_grid 69 | build_new_plot <- function(object, plot){ 70 | flag.params <- TRUE 71 | if (!inherits(plot$facet, "FacetNull")){ 72 | if (inherits(object$label, "labeller") || !is.null(names(object$label))){ 73 | facet.fun <- eval(parse(text=class(plot$facet)[1])) 74 | facet.obj <- ggplot2::ggproto(NULL, 75 | facet.fun, 76 | shrink = plot$facet$shrink, 77 | params = plot$facet$params 78 | ) 79 | if (!is.null(plot$facet$strip)){ 80 | facet.obj$strip <- plot$facet$strip 81 | } 82 | strip.labels <- extract_strip_label(facet=facet.fun, plot=plot) 83 | if (inherits(object$label, "labeller")){ 84 | tmp.label <- extract_strip_label(facet=facet.fun, plot=plot, labeller=object$label) 85 | names(tmp.label) <- names(strip.labels) 86 | object$label <- tmp.label[!is.na(tmp.label)] 87 | } 88 | newnm <- intersect(names(object$label), names(strip.labels)) 89 | if (length(newnm) > 0){ 90 | strip.labels[match(newnm, names(strip.labels))] <- object$label[match(newnm, names(object$label))] 91 | } 92 | facet.obj$params$labeller <- ggplot2::as_labeller(strip.labels) 93 | flag.params <- FALSE 94 | }else{ 95 | plot <- ggplotify::as.ggplot(plot) 96 | } 97 | } 98 | if (flag.params){ 99 | lb <- paste0("'", eval(object$label[1]), "'") 100 | if (object$side == 'top') { 101 | params <- list(paste0('~', lb)) 102 | } else { 103 | params <- list(paste0(lb, '~.')) 104 | } 105 | }else{ 106 | params <- NULL 107 | } 108 | if (!is.null(params)){ 109 | facet.layer <- do.call("facet_grid", params) 110 | th <- theme(strip.background = element_rect(fill='grey85', colour = NA), 111 | strip.text = element_text(colour = 'grey10', 112 | size = rel(0.8), 113 | angle = object$angle, 114 | margin = margin(4.4, 4.4, 4.4, 4.4)) 115 | ) 116 | plot <- plot + facet.layer + th 117 | }else{ 118 | plot <- plot + facet.obj 119 | } 120 | return (plot) 121 | } 122 | 123 | # #' set the theme of ggplot object with the striped background style. 124 | # #' @param colour character the color of the striped background, 125 | # #' default is c('grey90', 'white'). 126 | # #' @param axis character which grid of axis will be filled, default is 'y'. 127 | # #' @param ... additional parameter, see also 'theme' of 'ggplot2'. 128 | # #' @export 129 | # #' @examples 130 | # #' library(ggplot2) 131 | # #' iris |> tidyr::pivot_longer( 132 | # #' cols = !Species, 133 | # #' names_to = 'var', 134 | # #' values_to = 'value' 135 | # #' ) |> 136 | # #' ggplot( 137 | # #' aes(x=var, y=Species, color=value, size=value) 138 | # #' ) + 139 | # #' geom_point() -> p 140 | # #' p + 141 | # #' theme_stamp( 142 | # #' colour = c('grey90', 'white'), 143 | # #' axis = 'y', 144 | # #' axis.line.y=element_line() 145 | # #' ) 146 | # #' p + 147 | # #' theme_stamp( 148 | # #' colour = c('grey90', 'white'), 149 | # #' axis = 'x', 150 | # #' axis.line.x = element_line() 151 | # #' ) 152 | #theme_stamp <- function(colour=c('grey90', 'white'), axis = 'y', ...){ 153 | # params <- list(...) 154 | # axis <- match.arg(axis, c('x', 'y')) 155 | # if ('color' %in% names(params)){ 156 | # colour <- params$color 157 | # params$color <- NULL 158 | # } 159 | # if (length(colour)!=2){ 160 | # message('The colour is not a vector contained two length.') 161 | # #colour <- c('white', 'grey90') 162 | # } 163 | # structure( 164 | # list( 165 | # colour = colour, 166 | # axis = axis, 167 | # params = params 168 | # ), 169 | # class = 'theme_stamp' 170 | # ) 171 | #} 172 | # 173 | # #' @method ggplot_add theme_stamp 174 | # #' @export 175 | # #' @importFrom ggplot2 element_line geom_tile aes element_blank 176 | #ggplot_add.theme_stamp <- function(object, plot, object_name){ 177 | # gb <- ggplot2::ggplot_build(plot) 178 | # axis <- paste0('panel_scales_', object$axis) 179 | # df <- data.frame(AXIS=gb$layout[[axis]][[1]]$get_labels()) 180 | # len.ind <- length(object$colour) 181 | # axis.num <- nrow(df) 182 | # df$GROUP.GRID <- rep(object$colour, ceiling(axis.num/len.ind))[seq_len(axis.num)] 183 | # if (object$axis == 'y'){ 184 | # grid.tile <- geom_tile( 185 | # data = df, 186 | # mapping = aes(x = 1, 187 | # y = !!as.symbol("AXIS"), 188 | # fill = I(!!as.symbol("GROUP.GRID")), 189 | # height = 1, 190 | # width=Inf 191 | # ), 192 | # inherit.aes = FALSE 193 | # ) 194 | # }else{ 195 | # grid.tile <- geom_tile( 196 | # data = df, 197 | # mapping = aes(x = !!as.symbol("AXIS"), 198 | # y = 1, 199 | # fill = I(!!as.symbol("GROUP.GRID")), 200 | # height = Inf, 201 | # width = 1 202 | # ), 203 | # inherit.aes = FALSE 204 | # ) 205 | # } 206 | # plot <- plot + ggnewscale::new_scale_fill() + grid.tile 207 | # plot$layers <- c(plot$layers[[length(plot$layers)]], plot$layers[-length(plot$layers)]) 208 | # axis.keep <- paste0('axis.line.', setdiff(c('x', 'y'), object$axis)) 209 | # default.theme <- list(element_blank(), element_line()) 210 | # names(default.theme) <- c('panel.background', axis.keep) 211 | # if (axis.keep %in% names(object$params)){ 212 | # object$params <- c(object$params, default.theme[[-2]]) 213 | # }else{ 214 | # object$params <- c(object$params, default.theme) 215 | # } 216 | # th <- do.call("theme", object$params) 217 | # plot <- plot + th 218 | # return(plot) 219 | #} 220 | -------------------------------------------------------------------------------- /R/method-identify.R: -------------------------------------------------------------------------------- 1 | 2 | ##' identify node by interactive click 3 | ##' 4 | ##' 5 | ##' @rdname identify 6 | ##' @title identify 7 | ##' @param x tree view 8 | ##' @param col selected columns to extract. Default is "auto" which will select all columns for 'ggplot' object and 'node' column for 'ggtree' object 9 | ##' @param ... additional parameters, normally ignored 10 | ##' @return closest data point 11 | ##' @importFrom grid convertX 12 | ##' @importFrom grid convertY 13 | ##' @importFrom grid pushViewport 14 | ##' @importFrom grid grid.locator 15 | ##' @importFrom grid unit 16 | ##' @importFrom grid dataViewport 17 | ##' @importFrom graphics identify 18 | ##' @importFrom ggplot2 last_plot 19 | ##' @method identify gg 20 | ##' @export 21 | ##' @author Guangchuang Yu 22 | identify.gg <- function(x = last_plot(), col = "auto", ...) { 23 | ## tree_view <- x 24 | ## x=NULL, it will call graphics::identify 25 | 26 | ## x <- tree_view$data$x 27 | ## y <- tree_view$data$y 28 | 29 | plot <- x 30 | 31 | xvar <- get_aes_var(plot$mapping, 'x') 32 | yvar <- get_aes_var(plot$mapping, 'y') 33 | x <- plot$data[[xvar]] 34 | y <- plot$data[[yvar]] 35 | 36 | xlim <- rep(xrange(plot), times = 2) 37 | ylim <- rep(yrange(plot), each = 2) 38 | 39 | pushViewport(dataViewport(xlim, ylim)) 40 | loc <- as.numeric(grid.locator('in')) 41 | 42 | xx <- as.numeric(convertX( unit(x,'native'), 'in' )) 43 | yy <- as.numeric(convertY( unit(y,'native'), 'in' )) 44 | 45 | idx <- which.min( (xx-loc[1])^2 + (yy-loc[2])^2 ) 46 | res <- plot$data[idx,] 47 | if (col == "auto" && inherits(plot, 'ggtree')) { 48 | col <- 'node' 49 | } 50 | if (length(col) == 1 && col == "auto") { 51 | return(res) 52 | } 53 | 54 | res <- res[,col] 55 | if (length(col) == 1) { 56 | res <- res[[1]] 57 | } 58 | return(res) 59 | } 60 | 61 | ##' @importFrom graphics identify 62 | ##' @export 63 | graphics::identify 64 | 65 | -------------------------------------------------------------------------------- /R/operator.R: -------------------------------------------------------------------------------- 1 | #' @title %<+% 2 | #' @description 3 | #' This operator attaches annotation data to a ggtree or ggsc graphic object 4 | #' @rdname attacher 5 | #' @param p ggplot2 object, such as ggtree or ggsc graphic object. 6 | #' @param data data.frame, which must contains a column of \code{node}, 7 | #' or the first column of taxa labels, when \code{p} is a \code{ggtree} object. 8 | #' Or it must contains columns of \code{.BarcodeID}, when \code{p} is a \code{ggsc} 9 | #' object and \code{p$data} does not contain a column of \code{features}, if it 10 | #' contains, the \code{data} must also contains a column of \code{features}. 11 | #' @return ggplot object with annotation data added 12 | #' @export 13 | `%<+%` <- function(p, data){ 14 | if (! is.data.frame(data)) { 15 | cli::cli_abort("right object should be a data.frame...") 16 | } 17 | if (missing(data)){ 18 | cli::cli_abort(c( 19 | "Cannot use {.code %<+%} with a single argument.", 20 | "i" = "Did you accidentally put {.code %<+%} on a new line?" 21 | )) 22 | } 23 | UseMethod("%<+%") 24 | } 25 | 26 | 27 | #' @method %<+% ggtree 28 | #' @export 29 | "%<+%.ggtree" <- function(p, data){ 30 | p <- p %add% data 31 | return(p) 32 | } 33 | 34 | #' @method %<+% ggflow 35 | #' @export 36 | "%<+%.ggflow" <- function(p, data){ 37 | attach_merge_1st_with_label(p, data) 38 | } 39 | 40 | #' @method %<+% ggtangle 41 | #' @export 42 | "%<+%.ggtangle" <- function(p, data){ 43 | attach_merge_1st_with_label(p, data) 44 | } 45 | 46 | #' @method %<+% ggsc 47 | #' @export 48 | "%<+%.ggsc" <- function(p, data){ 49 | if (inherits(p, 'patchwork')){ 50 | p$patches$plots <- lapply(p$patches$plots, function(x){ 51 | p <- left_join(x, data) 52 | return(p)}) |> 53 | suppressMessages() 54 | } 55 | p <- left_join(p, data) |> suppressMessages() 56 | return(p) 57 | } 58 | 59 | 60 | `%add%` <- function(p, data) { 61 | p$data <- p$data %add2% data 62 | return(p) 63 | } 64 | 65 | ##' @importFrom dplyr rename 66 | ##' @importFrom dplyr left_join 67 | `%add2%` <- function(d1, d2) { 68 | if ("node" %in% colnames(d2)) { 69 | cn <- colnames(d2) 70 | ii <- which(cn %in% c("node", cn[!cn %in% colnames(d1)])) 71 | d2 <- d2[, ii] 72 | dd <- dplyr::left_join(d1, d2, by="node") 73 | } else { 74 | dd <- merge_1st_with_label(d1, d2) 75 | } 76 | dd <- dd[match(d1$node, dd$node), ,drop=FALSE] 77 | return(dd) 78 | } 79 | 80 | attach_merge_1st_with_label <- function(p, data) { 81 | p$data <- merge_1st_with_label(p$data, data) 82 | return(p) 83 | } 84 | 85 | merge_1st_with_label <- function(d1, d2) { 86 | d2[,1] <- as.character(unlist(d2[,1])) ## `unlist` to work with tbl_df 87 | d2 <- dplyr::rename(d2, label = 1) ## rename first column name to 'label' 88 | dd <- dplyr::left_join(d1, d2, by="label") 89 | return(dd) 90 | } 91 | 92 | 93 | #' @importFrom dplyr left_join 94 | #' @method left_join ggsc 95 | #' @importFrom cli cli_warn 96 | #' @export 97 | left_join.ggsc <- function(x, y, by = NULL, copy = FALSE, suffix=c("", ".y"), ...){ 98 | dat <- x$data 99 | msg <- c("The {.arg suffix} requires a character vector containing 2 different elements,", 100 | "The first element must be \"\", and the second element must not be \"\",", 101 | "it was set {.code suffix=c(\"\", \".y\")} automatically.") 102 | if (all(nchar(suffix)!=0)){ 103 | cli::cli_warn(msg) 104 | suffix[1] = "" 105 | } 106 | if (all(nchar(suffix)==0)){ 107 | cli::cli_warn(msg) 108 | suffix[2] = ".y" 109 | } 110 | if (nchar(suffix[1])!=0 && nchar(suffix[2])==0){ 111 | cli::cli_warn(msg) 112 | suffix <- rev(suffix[seq_len(2)]) 113 | } 114 | if ('features' %in% names(dat) && length(unique(dat$features))>1 && !'features' %in% names(y)){ 115 | cli::cli_abort(c("The `features` contains in the column of {.cls {class(x)[1]}}, but ", 116 | "the {.cls {class(y)[1]}} does not have `features` column."), call = NULL) 117 | } 118 | da <- dplyr::left_join(dat, y, by = by, copy = copy, suffix = suffix, ...) 119 | 120 | x$data <- da 121 | 122 | return(x) 123 | } 124 | 125 | -------------------------------------------------------------------------------- /R/reexport.R: -------------------------------------------------------------------------------- 1 | ##' @importFrom grid gpar 2 | ##' @export 3 | grid::gpar 4 | 5 | ## @import cli 6 | -------------------------------------------------------------------------------- /R/set_font.R: -------------------------------------------------------------------------------- 1 | ##' setting font for ggplot (axis text, label, title, etc.) 2 | ##' 3 | ##' 4 | ##' @title set_font 5 | ##' @param p ggplot object 6 | ##' @param family font fammily 7 | ##' @param fontface font face 8 | ##' @param size font size 9 | ##' @param color font color 10 | ##' @return TableGrob object 11 | ##' @importFrom grid editGrob 12 | ##' @importFrom grid grid.ls 13 | ##' @importFrom grid grid.force 14 | ##' @importFrom grid gPath 15 | ##' @importFrom grid gpar 16 | ##' @importFrom ggplot2 ggplotGrob 17 | ##' @importFrom ggplot2 .pt 18 | ##' @export 19 | ##' @examples 20 | ##' library(grid) 21 | ##' library(ggplot2) 22 | ##' d <- data.frame(x=rnorm(10), y=rnorm(10), lab=LETTERS[1:10]) 23 | ##' p <- ggplot(d, aes(x, y)) + geom_text(aes(label=lab), size=5) 24 | ##' set_font(p, family="Times", fontface="italic", color='firebrick') 25 | ##' @author Guangchuang Yu 26 | set_font <- function(p, family="sans", fontface=NULL, size=NULL, color=NULL) { 27 | if (!is.null(size)) 28 | size <- size * .pt 29 | par <- list(fontfamily = family, fontface = fontface, fontsize = size, col = color) 30 | par <- par[!sapply(par, is.null)] 31 | gp <- do.call(gpar, par) 32 | g <- ggplotGrob(p) 33 | ng <- grid.ls(grid.force(g), print=FALSE)$name 34 | txt <- ng[which(grepl("text", ng))] 35 | 36 | for (i in seq_along(txt)) { 37 | g <- editGrob(grid.force(g), gPath(txt[i]), 38 | grep = TRUE, gp = gp) 39 | } 40 | grid.draw(g) 41 | invisible(g) 42 | } 43 | -------------------------------------------------------------------------------- /R/theme.R: -------------------------------------------------------------------------------- 1 | #' @importFrom ggplot2 theme_get 2 | get_theme_params = function(x, i) { 3 | if (!inherits(x, "theme")) x <- x$theme 4 | if (length(x) == 0) { 5 | x <- ggplot2::theme_get() 6 | } 7 | x[i] 8 | } 9 | 10 | ##' theme format painter 11 | ##' 12 | ##' It applies theme element (i) from a ggplot (x) to another ggplot object 13 | ##' @title theme_fp 14 | ##' @param x ggplot object to provide theme format 15 | ##' @param i the element of a theme provided by `x` 16 | ##' @return theme element 17 | ##' @export 18 | ##' @author Guangchuang Yu and Shuangbin Xu 19 | theme_fp <- function(x, i) { 20 | params <- get_theme_params(x, i) 21 | params <- c(params, list(complete = TRUE)) 22 | do.call(theme, params) 23 | } 24 | 25 | 26 | ##' transparent background theme 27 | ##' 28 | ##' 29 | ##' @title theme_transparent 30 | ##' @param ... additional parameter to tweak the theme 31 | ##' @return ggplot object 32 | ##' @importFrom ggplot2 theme 33 | ##' @importFrom ggplot2 element_rect 34 | ##' @export 35 | ##' @author Guangchuang Yu with contributions from Hugo Gruson 36 | theme_transparent <- function (...){ 37 | theme(panel.background = element_rect(fill = "transparent", 38 | colour = NA), plot.background = element_rect(fill = "transparent", 39 | colour = NA), legend.key = element_rect(fill = "transparent", 40 | colour = NA), legend.background = element_rect(fill = "transparent", 41 | colour = NA), ...) 42 | } 43 | 44 | ##' A theme that only show the plot panel 45 | ##' 46 | ##' 47 | ##' @title theme_nothing 48 | ##' @param base_size font size 49 | ##' @param base_family font family 50 | ##' @importFrom ggplot2 %+replace% 51 | ##' @importFrom ggplot2 aes_ 52 | ##' @importFrom ggplot2 theme_void 53 | ##' @return ggplot2 theme 54 | ##' @export 55 | ##' @author Guangchuang Yu 56 | theme_nothing <- function(base_size = 11, base_family = "") { 57 | theme_void(base_size = base_size, base_family = base_family) %+replace% 58 | theme(plot.margin=grid::unit(c(0,0, -.2, -.2), "lines")) 59 | } 60 | 61 | ##' A theme that only show y-axis 62 | ##' 63 | ##' 64 | ##' @title theme_noxaxis 65 | ##' @rdname theme-no-axis 66 | ##' @param color color of y-axis 67 | ##' @param ... additional parameters that passed to theme() 68 | ##' @return ggplot2 theme 69 | ##' @importFrom ggplot2 element_blank 70 | ##' @importFrom ggplot2 element_line 71 | ##' @export 72 | ##' @author Guangchuang Yu 73 | theme_noxaxis <- function(color = 'black', ...) { 74 | theme(axis.line.x = element_blank(), 75 | axis.text.x = element_blank(), 76 | axis.ticks.x = element_blank(), 77 | axis.line.y = element_line(color = color), 78 | axis.text.y = element_text(color = color), 79 | axis.ticks.y = element_line(color = color), 80 | ...) 81 | } 82 | 83 | 84 | ##' @rdname theme-no-axis 85 | ##' @export 86 | theme_noyaxis <- function(color = 'black', ...) { 87 | theme(axis.line.y = element_blank(), 88 | axis.text.y = element_blank(), 89 | axis.ticks.y = element_blank(), 90 | axis.line.x = element_line(color = color), 91 | axis.text.x = element_text(color = color), 92 | axis.ticks.x = element_line(color = color), 93 | ...) 94 | } 95 | 96 | 97 | ##' @rdname theme-no-axis 98 | ##' @export 99 | theme_noaxis <- function(...) { 100 | theme(axis.line.y = element_blank(), 101 | axis.text.y = element_blank(), 102 | axis.ticks.y = element_blank(), 103 | axis.line.x = element_blank(), 104 | axis.text.x = element_blank(), 105 | axis.ticks.x = element_blank(), 106 | ...) 107 | } 108 | 109 | 110 | ##' A theme that has no margin 111 | ##' 112 | ##' 113 | ##' @title theme_no_margin 114 | ##' @param ... additional parameters that passed to theme() 115 | ##' @return ggplot2 theme 116 | ##' @importFrom ggplot2 margin 117 | ##' @export 118 | ##' @author Guangchuang Yu 119 | theme_no_margin <- function(...) { 120 | ggplot2::theme(plot.margin = ggplot2::margin(), ...) 121 | } 122 | 123 | 124 | ##' the theme of blind-like 125 | ##' @param colour the colour of rectangular, default is c('white', 'grey60'). 126 | ##' @param axis character which grid of axis will be filled, default is 'y'. 127 | ##' @param ... additional parameters that passed to \code{theme} function. 128 | ##' @return ggplot2 theme 129 | ##' @export 130 | ##' @examples 131 | ##' library(ggplot2) 132 | ##' iris |> tidyr::pivot_longer( 133 | ##' cols = !Species, 134 | ##' names_to = 'var', 135 | ##' values_to = 'value' 136 | ##' ) |> 137 | ##' ggplot( 138 | ##' aes(x=var, y=Species, color=value, size=value) 139 | ##' ) + 140 | ##' geom_point() -> p 141 | ##' p + 142 | ##' theme_blinds( 143 | ##' colour = c('grey90', 'white'), 144 | ##' axis = 'y', 145 | ##' axis.line.y=element_line() 146 | ##' ) 147 | ##' p + 148 | ##' theme_blinds( 149 | ##' colour = c('grey90', 'white'), 150 | ##' axis = 'x', 151 | ##' axis.line.x = element_line() 152 | ##' ) 153 | theme_blinds <- function(colour = c('white', 'grey'), axis = 'y', ...){ 154 | dots <- list(...) 155 | if ('color' %in% names(dots)){ 156 | colour <- dots$color 157 | } 158 | dots[[paste0("panel.grid.major.", axis)]] <- element_blinds(colour = colour, axis = axis) 159 | do.call("theme", dots) 160 | } 161 | 162 | #' the theme of blind-like alias of theme_blinds 163 | #' @param colour the colour of rectangular, default is c('white', 'grey60'). 164 | #' @param axis character which grid of axis will be filled, default is 'y'. 165 | #' @param ... additional parameters that passed to \code{theme} function. 166 | #' @export 167 | theme_stamp <- theme_blinds 168 | -------------------------------------------------------------------------------- /R/treedata-function.R: -------------------------------------------------------------------------------- 1 | ##' filter data for tree annotation layer 2 | ##' 3 | ##' The 'td_filter()' function returns another function that can be 4 | ##' used to subset ggtree() plot data. The function can be passed to the 'data' parameter 5 | ##' of geom layer to perform subsetting. All rows that satisy your conditions will be retained. 6 | ##' @title td-filter 7 | ##' @param ... Expressions that return a logical value. 8 | ##' @param .f a function (if any, defaults to NULL) that pre-operate the data 9 | ##' @return A function to filter ggtree plot data using conditions defined by '...'. 10 | ##' @seealso 11 | ##' [filter][dplyr::filter] 12 | ##' @author Guangchuang Yu 13 | ##' @examples 14 | ##' \dontrun{ 15 | ##' tree <- rtree(30) 16 | ##' ## similar to 'ggtree(tree) + geom_tippoint()' 17 | ##' ggtree(tree) + geom_point(data = td_filter(isTip)) 18 | ##' } 19 | ##' @references 20 | ##' For more detailed demonstration of this function, please refer to chapter 12.5.1 of 21 | ##' *Data Integration, Manipulation and Visualization of Phylogenetic Trees* 22 | ##' by Guangchuang Yu. 23 | ##' @export 24 | td_filter <- function(..., .f = NULL) { 25 | dots <- rlang::quos(...) 26 | function(.data) { 27 | if (!is.null(.f)) .data <- .f(.data) 28 | dplyr::filter(.data, !!!dots) 29 | } 30 | } 31 | 32 | ##' flatterns a list-column of data frame 33 | ##' 34 | ##' The 'td_unnest' function returns another function that can be 35 | ##' used to unnest ggtree() plot data. The function can be passed to 36 | ##' the 'data' parameter of a geom layer to flattern list-cloumn tree data. 37 | ##' @title td-unnest 38 | ##' @param cols columns to unnest 39 | ##' @param ... additional parameters that pass to tidyr::unnest 40 | ##' @param .f a function (if any, defaults to NULL) that pre-operate the data 41 | ##' @return A function to unnest ggtree plot data 42 | ##' @seealso 43 | ##' [unnest][tidyr::unnest] 44 | ##' @author Guangchuang Yu 45 | ##' @references 46 | ##' For demonstration of this function, please refer to chapter 12.5.2 of 47 | ##' *Data Integration, Manipulation and Visualization of Phylogenetic Trees* 48 | ##' by Guangchuang Yu. 49 | ##' @export 50 | td_unnest <- function(cols, ..., .f = NULL) { 51 | function(.data) { 52 | if (!is.null(.f)) .data <- .f(.data) 53 | tidyr::unnest(.data, {{cols}}, ...) 54 | } 55 | } 56 | 57 | ##' mutate data for tree annotation layer 58 | ##' 59 | ##' The 'td_mutate()' function returns another function that can be 60 | ##' used to mutate ggtree() plot data. The function can be passed to the 'data' parameter 61 | ##' of geom layer to perform adding new variables and preserving existing ones. 62 | ##' @title td-mutate 63 | ##' @param ... additional parameters that pass to dplyr::mutate 64 | ##' @param .f a function (if any, defaults to NULL) that pre-operate the data 65 | ##' @return A function to mutate ggtree plot data 66 | ##' @seealso 67 | ##' [mutate][dplyr::mutate] 68 | ##' @export 69 | td_mutate <- function(..., .f=NULL){ 70 | function(.data){ 71 | if (!is.null(.f)) .data <- .f(.data) 72 | dplyr::mutate(.data, ...) 73 | } 74 | } 75 | -------------------------------------------------------------------------------- /R/utilities.R: -------------------------------------------------------------------------------- 1 | ##' override point legend set by 'aes(shape = I(shape))' 2 | ##' 3 | ##' 4 | ##' @title set_point_legend_shape 5 | ##' @param plot a 'gg' plot object 6 | ##' @return an updated plot 7 | ##' @importFrom ggplot2 guides 8 | ##' @importFrom ggplot2 guide_legend 9 | ##' @export 10 | ##' @author Guangchuang Yu 11 | set_point_legend_shape <- function(plot) { 12 | pshape <- get_aes_var(plot$mapping, 'shape') 13 | if (is.null(pshape) || pshape == "NULL") { 14 | return(plot) 15 | } 16 | 17 | pshape <- eval(parse(text = pshape)) 18 | 19 | plot + guides(size = guide_legend(override.aes = list(shape = pshape))) 20 | } 21 | 22 | ## default point shape for enrichplot 23 | enrichplot_point_shape <- 21 24 | 25 | 26 | ##' extract data from a 'gg' plot 27 | ##' 28 | ##' 29 | ##' @title get_plot_data 30 | ##' @param plot a 'gg' plot object 31 | ##' @param var variables to be extracted 32 | ##' @param layer specific layer to extract the data 33 | ##' @return a data frame of selected variables 34 | ##' @importFrom cli cli_alert 35 | ##' @export 36 | ##' @author Guangchuang Yu 37 | get_plot_data <- function(plot, var = NULL, layer = NULL) { 38 | if (!inherits(plot, 'gg')) { 39 | stop("'plot' should be a 'gg' object.") 40 | } 41 | 42 | if (is.null(var)) { 43 | return(plot$data) 44 | } 45 | 46 | 47 | if (is.null(layer)) { 48 | ly <- plot 49 | } else if (is.numeric(layer) && length(layer) == 1) { 50 | ly <- plot$layers[[layer]] 51 | } else { 52 | cli::cli_alert("invalid layer, set to NULL automatically") 53 | ly <- plot 54 | } 55 | 56 | d <- ly$data 57 | if (length(d) == 0) { 58 | d <- plot$data 59 | } 60 | 61 | m <- ly$mapping 62 | 63 | if (is.null(m)) { 64 | mapping <- plot$mapping 65 | } else { 66 | mapping <- modifyList(plot$mapping, m) 67 | } 68 | 69 | if (length(d) == 0) { 70 | cli::cli_alert("No data found.") 71 | cli::cli_alert("You need to set a proper 'layer' index to locate the layer data.") 72 | 73 | return(NULL) 74 | } 75 | 76 | var2 <- var 77 | i <- which(! var2 %in% names(d)) 78 | 79 | if (length(i) > 0 && 80 | (is.null(mapping) || length(mapping) == 0) 81 | ) { 82 | cli::cli_alert("Not aes mapping found.") 83 | cli::cli_alert("You nedd to set a proper 'layer' index to locate the layer mapping.") 84 | 85 | return(NULL) 86 | } 87 | 88 | var2[i] <- vapply(X = var2[i], 89 | FUN = get_aes_var, 90 | FUN.VALUE = character(1), 91 | mapping = mapping) 92 | 93 | d[, var2, drop = FALSE] 94 | } 95 | 96 | ##' extract aes mapping, compatible with ggplot2 < 2.3.0 & > 2.3.0 97 | ##' 98 | ##' 99 | ##' @title get_aes_var 100 | ##' @param mapping aes mapping 101 | ##' @param var variable 102 | ##' @return mapped var 103 | ##' @importFrom utils tail 104 | ##' @importFrom rlang quo_text 105 | ##' @export 106 | ##' @author Guangchuang Yu 107 | get_aes_var <- function(mapping, var) { 108 | res <- rlang::quo_text(mapping[[var]]) 109 | 110 | ## to compatible with ggplot2 v=2.2.2 111 | res <- tail(res, 1) |> 112 | ## to compatible with .data[[var]] 113 | sub('^.data\\[\\[(.*)\\]\\]$', "\\1", x=_) |> 114 | ## to compatible with .data$var 115 | sub('^.data\\$(.*)$', "\\1", x=_) |> 116 | ## to remove quote 117 | gsub('\\"', "", x=_) 118 | 119 | return(res) 120 | } 121 | 122 | #check_labeller <- utils::getFromNamespace("check_labeller", "ggplot2") 123 | 124 | extract_strip_label <- function(facet, plot, labeller=NULL){ 125 | layout <- facet$compute_layout(list(plot$data), 126 | c(plot$facet$params, 127 | list(.possible_columns=names(plot$data)), 128 | plot_env = plot$plot_env 129 | ) 130 | ) 131 | label_df <- layout[names(c(plot$facet$params$facet, 132 | plot$facet$params$cols, 133 | plot$facet$params$rows))] 134 | if (is.null(labeller)){ 135 | labels <- lapply(plot$facet$params$labeller(label_df), cbind) 136 | }else{ 137 | labels <- lapply(labeller(label_df), cbind) 138 | } 139 | labels <- do.call("cbind", labels) 140 | labels <- unique(as.vector(labels)) 141 | names(labels) <- labels 142 | return(labels) 143 | } 144 | 145 | 146 | ##' convert a ggbreak object to a ggplot object 147 | ##' 148 | ##' 149 | ##' @title ggbreak2ggplot 150 | ##' @param plot a ggbreak object 151 | ##' @return a ggplot object 152 | ##' @export 153 | ##' @author Guangchuang Yu 154 | ggbreak2ggplot <- function(plot) { 155 | ggplotify::as.ggplot(grid.draw(plot, recording = FALSE)) 156 | } 157 | 158 | ##' check whether a plot is a ggbreak object (including 'ggbreak', 'ggwrap' and 'ggcut' that defined in the 'ggbreak' package) 159 | ##' 160 | ##' 161 | ##' @title is.ggbreak 162 | ##' @rdname is-ggbreak 163 | ##' @param plot a plot obejct 164 | ##' @return logical value 165 | ##' @export 166 | ##' @author Guangchuang Yu 167 | is.ggbreak <- function(plot) { 168 | if (inherits(plot, 'ggbreak') || 169 | inherits(plot, 'ggwrap') || 170 | inherits(plot, 'ggcut') 171 | ) return(TRUE) 172 | 173 | return(FALSE) 174 | } 175 | 176 | 177 | ##' test whether input object is produced by ggtree function 178 | ##' 179 | ##' 180 | ##' @title is.ggtree 181 | ##' @param x object 182 | ##' @return TRUE or FALSE 183 | ##' @export 184 | ##' @author Guangchuang Yu 185 | ## copy from treeio 186 | is.ggtree <- function(x) { 187 | if (inherits(x, 'ggtree')) return(TRUE) 188 | 189 | if (!inherits(x, 'gg')) return(FALSE) 190 | 191 | ## to compatible with user using `ggplot(tree) + geom_tree()` 192 | 193 | tree_layer <- vapply(x$layers, 194 | function(y) { 195 | any(grepl("StatTree", class(y$stat))) 196 | }, 197 | logical(1) 198 | ) 199 | return(any(tree_layer)) 200 | } 201 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | #' @importFrom yulab.utils yulab_msg 2 | .onAttach <- function(libname, pkgname) { 3 | packageStartupMessage(yulab.utils::yulab_msg(pkgname)) 4 | } 5 | 6 | -------------------------------------------------------------------------------- /inst/prototype/geom_rtile.r: -------------------------------------------------------------------------------- 1 | 2 | geom_rtile <- function(mapping = NULL, data = NULL, r = 0.1, ...) { 3 | layer( 4 | data = data, 5 | mapping = mapping, 6 | geom = GeomRtile, 7 | stat = "identity", 8 | position = "identity", 9 | params = rlang::list2(r=r, ...), 10 | check.aes = FALSE 11 | ) 12 | } 13 | 14 | 15 | GeomRtile <- ggproto("GeomRtile", Geom, 16 | 17 | draw_panel = function(data, panel_scales, coord, width=NULL, height=NULL, r=.1) { 18 | data <- coord$transform(data, panel_scales) 19 | data$width <- data$width %||% width %||% resolution(data$x, FALSE) 20 | data$height <- data$height %||% height %||% resolution(data$y, FALSE) 21 | data$r <- data$r %||% r 22 | grobs <- lapply(1:nrow(data), function(i) { 23 | vp <- viewport(x=data$x[i], y=data$y[i], 24 | width=data$width[i], height=data$height[i], 25 | just = c("center", "center"), 26 | default.units = "npc") 27 | roundrectGrob(x = data$x[i], y = data$y[i], 28 | r = unit(data$r[i], 'snpc'), 29 | gp = gpar(col = data$colour[i], 30 | #fill_alpha(data$fill[i], data$alpha[i]) 31 | fill = data$fill[i] 32 | ), 33 | vp=vp, name=i) 34 | }) 35 | class(grobs) <- "gList" 36 | ggplot2:::ggname("geom_rtilee", 37 | gTree(children = grobs)) 38 | }, 39 | non_missing_aes = c("x", "y", "width", "height"), 40 | default_aes = aes(colour =NA), 41 | draw_key = draw_key_blank 42 | ) 43 | 44 | 45 | 46 | ggplot(d, aes(row, col)) + geom_rtile(aes(fill=value)) + ggexpand(.2) + ggexpand(.2, -1) 47 | 48 | -------------------------------------------------------------------------------- /man/attacher.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/operator.R 3 | \name{\%<+\%} 4 | \alias{\%<+\%} 5 | \title{\%<+\%} 6 | \usage{ 7 | p \%<+\% data 8 | } 9 | \arguments{ 10 | \item{p}{ggplot2 object, such as ggtree or ggsc graphic object.} 11 | 12 | \item{data}{data.frame, which must contains a column of \code{node}, 13 | or the first column of taxa labels, when \code{p} is a \code{ggtree} object. 14 | Or it must contains columns of \code{.BarcodeID}, when \code{p} is a \code{ggsc} 15 | object and \code{p$data} does not contain a column of \code{features}, if it 16 | contains, the \code{data} must also contains a column of \code{features}.} 17 | } 18 | \value{ 19 | ggplot object with annotation data added 20 | } 21 | \description{ 22 | This operator attaches annotation data to a ggtree or ggsc graphic object 23 | } 24 | -------------------------------------------------------------------------------- /man/element_blinds.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggelement.R 3 | \name{element_blinds} 4 | \alias{element_blinds} 5 | \title{this element is used to control the line color of panel.grid.major/minor.x 6 | or panel.grid.major/minor.y} 7 | \usage{ 8 | element_blinds( 9 | colour = c("white", "grey60"), 10 | axis, 11 | color = NULL, 12 | inherit.blank = FALSE 13 | ) 14 | } 15 | \arguments{ 16 | \item{colour}{the colour of rectangular, default is c('white', 'grey60').} 17 | 18 | \item{axis}{character, require, option is \code{y} or \code{x}.} 19 | 20 | \item{color, }{Color is an alias for colour} 21 | 22 | \item{inherit.blank}{Should this element inherit the existence of an 23 | \code{element_blank} among its parents? If \code{TRUE} the existence of 24 | a blank element among its parents will cause this element to be blank as 25 | well. If \code{FALSE} any blank parent element will be ignored when 26 | calculating final element state.} 27 | } 28 | \description{ 29 | this element is used to control the line color of panel.grid.major/minor.x 30 | or panel.grid.major/minor.y 31 | } 32 | \examples{ 33 | library(ggplot2) 34 | df <- data.frame( 35 | x = rep(c(2, 5, 7, 9, 12), 2), 36 | y = rep(c(1, 2), each = 5), 37 | z = factor(rep(1:5, each = 2)), 38 | w = rep(diff(c(0, 4, 6, 8, 10, 14)), 2) 39 | ) 40 | ggplot(df, aes(x, y)) + geom_tile(aes(fill = z), colour = 'grey50') + 41 | theme(panel.grid.major.y = element_blinds(color= c('white', 'grey'), axis='y')) 42 | } 43 | -------------------------------------------------------------------------------- /man/element_roundrect.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggelement.R 3 | \name{element_roundrect} 4 | \alias{element_roundrect} 5 | \title{round rectangle borders and backgrounds} 6 | \usage{ 7 | element_roundrect( 8 | fill = NULL, 9 | colour = NULL, 10 | linewidth = NULL, 11 | linetype = NULL, 12 | color = NULL, 13 | r = grid::unit(0.1, "snpc"), 14 | inherit.blank = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{fill}{Fill colour. \code{fill_alpha()} can be used to set the transparency 19 | of the fill.} 20 | 21 | \item{colour, color}{Line/border colour. Color is an alias for colour. 22 | \code{alpha()} can be used to set the transparency of the colour.} 23 | 24 | \item{linewidth}{Line/border size in mm} 25 | 26 | \item{linetype}{Line type for lines and borders respectively. An 27 | integer (0:8), a name (blank, solid, dashed, dotted, dotdash, 28 | longdash, twodash), or a string with an even number (up to eight) 29 | of hexadecimal digits which give the lengths in consecutive positions 30 | in the string.} 31 | 32 | \item{r}{the radius of the rounded corners, a \code{unit} object, 33 | default is unit(0.1, 'snpc').} 34 | 35 | \item{inherit.blank}{Should this element inherit the existence of an 36 | \code{element_blank} among its parents? If \code{TRUE} the existence of 37 | a blank element among its parents will cause this element to be blank as 38 | well. If \code{FALSE} any blank parent element will be ignored when 39 | calculating final element state.} 40 | } 41 | \description{ 42 | round rectangle borders and backgrounds 43 | } 44 | \examples{ 45 | library(ggplot2) 46 | p <- ggplot(mpg, aes(displ, cty)) + geom_point() 47 | p <- p + facet_grid(cols = vars(cyl)) 48 | p <- p + theme(strip.background=element_roundrect(fill="grey40", color=NA, r=0.15)) 49 | p 50 | p2 <- ggplot(mtcars, aes(mpg, disp, color=factor(cyl), size=cyl)) + 51 | geom_point() 52 | p2 + theme(legend.background=element_roundrect(color="#808080", linetype=2)) 53 | } 54 | -------------------------------------------------------------------------------- /man/facet_set.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/facet_set.R 3 | \name{facet_set} 4 | \alias{facet_set} 5 | \title{facet_set} 6 | \usage{ 7 | facet_set(label, side = "t", angle = NULL) 8 | } 9 | \arguments{ 10 | \item{label}{a character or a named vector to label the plot} 11 | 12 | \item{side}{to label the plot at which side, either 't' (top) or 'r' (right)} 13 | 14 | \item{angle}{angle of the facet label. Default is 0 for side='t' and -90 for side='r'.} 15 | } 16 | \value{ 17 | a ggplot with facet label 18 | } 19 | \description{ 20 | add a facet label to a ggplot or change facet label of a ggplot 21 | } 22 | -------------------------------------------------------------------------------- /man/geom_cake.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_cake.R 3 | \name{geom_cake} 4 | \alias{geom_cake} 5 | \title{geom_cake} 6 | \usage{ 7 | geom_cake(mapping = NULL, data = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{mapping}{aes mapping} 11 | 12 | \item{data}{data} 13 | 14 | \item{...}{additional parameters} 15 | } 16 | \value{ 17 | ggplot2 layer 18 | } 19 | \description{ 20 | ggplot2 layer of birthday cake 21 | } 22 | \examples{ 23 | library(ggplot2) 24 | ggplot(mtcars, aes(mpg, disp)) + geom_cake() 25 | library(ggplot2) 26 | ggplot(mtcars, aes(mpg, disp)) + geom_cake() 27 | } 28 | \author{ 29 | Guangchuang Yu 30 | } 31 | -------------------------------------------------------------------------------- /man/geom_scatter_rect.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-scatter-rect.R 3 | \name{geom_scatter_rect} 4 | \alias{geom_scatter_rect} 5 | \title{geom_scatter_rect} 6 | \usage{ 7 | geom_scatter_rect( 8 | mapping = NULL, 9 | data = NULL, 10 | asp = 0.6, 11 | width = 0.8, 12 | height = NULL, 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{mapping}{aesthetic mapping, default is NULL} 18 | 19 | \item{data}{input data, default is NULL} 20 | 21 | \item{asp}{aspect ration of rectangle box (height vs width), only works for height is missing} 22 | 23 | \item{width}{width of the rectangles, default is 0.8} 24 | 25 | \item{height}{height of the rectangles} 26 | 27 | \item{...}{additional parameters passed to 'geom_rect'} 28 | } 29 | \description{ 30 | draw rectangle boxes as scatter points 31 | } 32 | \author{ 33 | Guangchuang Yu 34 | } 35 | -------------------------------------------------------------------------------- /man/geom_segment_c.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_segment_c.R 3 | \name{geom_segment_c} 4 | \alias{geom_segment_c} 5 | \title{geom_segment_c} 6 | \usage{ 7 | geom_segment_c( 8 | mapping = NULL, 9 | data = NULL, 10 | position = "identity", 11 | lineend = "butt", 12 | na.rm = FALSE, 13 | show.legend = NA, 14 | inherit.aes = TRUE, 15 | arrow = NULL, 16 | arrow.fill = NULL, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{mapping}{aes mapping} 22 | 23 | \item{data}{data} 24 | 25 | \item{position}{position} 26 | 27 | \item{lineend}{lineend} 28 | 29 | \item{na.rm}{logical} 30 | 31 | \item{show.legend}{logical} 32 | 33 | \item{inherit.aes}{logical} 34 | 35 | \item{arrow}{specification for arrow heads, as created by arrow().} 36 | 37 | \item{arrow.fill}{fill color to usse for the arrow head (if closed). \code{NULL} means use \code{colour} aesthetic.} 38 | 39 | \item{...}{additional parameter} 40 | } 41 | \value{ 42 | add segment layer 43 | } 44 | \description{ 45 | geom_segment_c supports coloring segment with continuous colors 46 | } 47 | \examples{ 48 | set.seed(2019-06-28) 49 | d = data.frame(x = rnorm(10), 50 | xend = rnorm(10), 51 | y = rnorm(10), 52 | yend = rnorm(10), 53 | v1 = rnorm(10), 54 | v2 = rnorm(10)) 55 | library(ggplot2) 56 | ggplot(d) + geom_segment_c(aes(x = x, xend = xend, y=y, yend =yend, col0 = v1, col1 = v2)) + 57 | scale_color_viridis_c(name = "continuous colored lines") + 58 | theme_minimal() + theme(legend.position=c(.2, .85)) + xlab(NULL) + ylab(NULL) 59 | } 60 | \seealso{ 61 | \link[ggplot2]{geom_segment} 62 | } 63 | \author{ 64 | Guangchuang Yu 65 | } 66 | -------------------------------------------------------------------------------- /man/geom_triangle.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom_triangle.R 3 | \name{geom_triangle} 4 | \alias{geom_triangle} 5 | \title{geom_triangle} 6 | \usage{ 7 | geom_triangle(mapping = NULL, data = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{mapping}{aes mapping} 11 | 12 | \item{data}{data} 13 | 14 | \item{...}{additional parameters} 15 | } 16 | \value{ 17 | ggplot2 layer 18 | } 19 | \description{ 20 | ggplot2 layer of triangle 21 | } 22 | \examples{ 23 | library(ggplot2) 24 | ggplot(mtcars, aes(mpg, disp)) + geom_triangle() 25 | } 26 | \author{ 27 | Shipeng Guo 28 | } 29 | -------------------------------------------------------------------------------- /man/geom_volpoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-volpoint.R 3 | \name{geom_volpoint} 4 | \alias{geom_volpoint} 5 | \title{geom_volpoint} 6 | \usage{ 7 | geom_volpoint( 8 | mapping = NULL, 9 | data = NULL, 10 | log2FC_cutoff = 2, 11 | p_cutoff = 1e-05, 12 | ... 13 | ) 14 | } 15 | \arguments{ 16 | \item{mapping}{aesthetic mapping} 17 | 18 | \item{data}{input data set} 19 | 20 | \item{log2FC_cutoff}{cutoff values for log2FC} 21 | 22 | \item{p_cutoff}{cutoff values p-value or adjusted p-value} 23 | 24 | \item{...}{additional paramters passed to the layer} 25 | } 26 | \value{ 27 | a ggplot 28 | } 29 | \description{ 30 | layer of scatter points for volcano plot to visualize differential genes 31 | } 32 | -------------------------------------------------------------------------------- /man/get-legend.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get-legend.r 3 | \name{get_legend} 4 | \alias{get_legend} 5 | \title{get_legend} 6 | \usage{ 7 | get_legend(plot) 8 | } 9 | \arguments{ 10 | \item{plot}{a gg or gtable object} 11 | } 12 | \value{ 13 | a 'gtable' object of the legend 14 | } 15 | \description{ 16 | extract legend from a plot 17 | } 18 | \author{ 19 | Guangchuang Yu 20 | } 21 | -------------------------------------------------------------------------------- /man/get_aes_var.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{get_aes_var} 4 | \alias{get_aes_var} 5 | \title{get_aes_var} 6 | \usage{ 7 | get_aes_var(mapping, var) 8 | } 9 | \arguments{ 10 | \item{mapping}{aes mapping} 11 | 12 | \item{var}{variable} 13 | } 14 | \value{ 15 | mapped var 16 | } 17 | \description{ 18 | extract aes mapping, compatible with ggplot2 < 2.3.0 & > 2.3.0 19 | } 20 | \author{ 21 | Guangchuang Yu 22 | } 23 | -------------------------------------------------------------------------------- /man/get_plot_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{get_plot_data} 4 | \alias{get_plot_data} 5 | \title{get_plot_data} 6 | \usage{ 7 | get_plot_data(plot, var = NULL, layer = NULL) 8 | } 9 | \arguments{ 10 | \item{plot}{a 'gg' plot object} 11 | 12 | \item{var}{variables to be extracted} 13 | 14 | \item{layer}{specific layer to extract the data} 15 | } 16 | \value{ 17 | a data frame of selected variables 18 | } 19 | \description{ 20 | extract data from a 'gg' plot 21 | } 22 | \author{ 23 | Guangchuang Yu 24 | } 25 | -------------------------------------------------------------------------------- /man/ggbreak2ggplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{ggbreak2ggplot} 4 | \alias{ggbreak2ggplot} 5 | \title{ggbreak2ggplot} 6 | \usage{ 7 | ggbreak2ggplot(plot) 8 | } 9 | \arguments{ 10 | \item{plot}{a ggbreak object} 11 | } 12 | \value{ 13 | a ggplot object 14 | } 15 | \description{ 16 | convert a ggbreak object to a ggplot object 17 | } 18 | \author{ 19 | Guangchuang Yu 20 | } 21 | -------------------------------------------------------------------------------- /man/ggfun-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggfun-package.R 3 | \docType{package} 4 | \name{ggfun-package} 5 | \alias{ggfun} 6 | \alias{ggfun-package} 7 | \title{ggfun: Miscellaneous Functions for 'ggplot2'} 8 | \description{ 9 | Useful functions and utilities for 'ggplot' object (e.g., geometric layers, themes, and utilities to edit the object). 10 | } 11 | \seealso{ 12 | Useful links: 13 | \itemize{ 14 | \item \url{https://github.com/YuLab-SMU/ggfun} 15 | \item Report bugs at \url{https://github.com/YuLab-SMU/ggfun/issues} 16 | } 17 | 18 | } 19 | \author{ 20 | \strong{Maintainer}: Guangchuang Yu \email{guangchuangyu@gmail.com} (\href{https://orcid.org/0000-0002-6485-8781}{ORCID}) [copyright holder] 21 | 22 | Authors: 23 | \itemize{ 24 | \item Shuangbin Xu \email{xshuangbin@163.com} (\href{https://orcid.org/0000-0003-3513-5362}{ORCID}) 25 | } 26 | 27 | } 28 | \keyword{internal} 29 | -------------------------------------------------------------------------------- /man/gglegend.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gglegend.R 3 | \name{gglegend} 4 | \alias{gglegend} 5 | \title{gglegend} 6 | \usage{ 7 | gglegend(mapping, data, geom, p = NULL) 8 | } 9 | \arguments{ 10 | \item{mapping}{aes mapping for the 'geom'. The first mapping should be the one for the legend, 11 | while others maybe needed for the 'geom' (e.g., label for geom_text).} 12 | 13 | \item{data}{input data frame. If users want to mapping 'VALUE' to 'colour', 14 | the input data should contains 'VALUE' and 'colour' (actual value, e.g., 'red' and 'blue') variable.} 15 | 16 | \item{geom}{a geom to plot the data for generating the legend and the geom will be plotted invisible.} 17 | 18 | \item{p}{a ggplot object. If NULL, the 'last_plot()' will be used.} 19 | } 20 | \value{ 21 | a ggplot object 22 | } 23 | \description{ 24 | add manual setting legend 25 | } 26 | \details{ 27 | add additional legend to a ggplot 28 | } 29 | \examples{ 30 | library(ggplot2) 31 | p <- ggplot(mtcars, aes(mpg, disp)) + geom_point() 32 | data <- data.frame(colour = c("red", "blue"), VALUE = c("A", "B")) 33 | gglegend(aes(colour = VALUE, label=VALUE), data, geom_text, p) 34 | } 35 | \author{ 36 | Guangchuang Yu 37 | } 38 | -------------------------------------------------------------------------------- /man/ggrange.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/axis.R 3 | \name{yrange} 4 | \alias{yrange} 5 | \alias{xrange} 6 | \alias{ggrange} 7 | \title{plot range of a ggplot object} 8 | \usage{ 9 | yrange(gg, type = "limit", region = "panel") 10 | 11 | xrange(gg, type = "limit", region = "panel") 12 | 13 | ggrange(gg, var, type = "limit", region = "panel") 14 | } 15 | \arguments{ 16 | \item{gg}{a ggplot object} 17 | 18 | \item{type}{one of 'limit' or 'range', if 'region == "plot"', 19 | to extract plot limit or plot data range} 20 | 21 | \item{region}{one of 'panel' or 'plot' to indicate extracting range 22 | based on the plot panel (scale expand will be counted) or 23 | plot data (scale expand will not be counted)} 24 | 25 | \item{var}{either 'x' or 'y'} 26 | } 27 | \value{ 28 | range of selected axis 29 | } 30 | \description{ 31 | extract x or y ranges of a ggplot 32 | } 33 | \author{ 34 | Guangchuang Yu 35 | } 36 | -------------------------------------------------------------------------------- /man/identify.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method-identify.R 3 | \name{identify.gg} 4 | \alias{identify.gg} 5 | \title{identify} 6 | \usage{ 7 | \method{identify}{gg}(x = last_plot(), col = "auto", ...) 8 | } 9 | \arguments{ 10 | \item{x}{tree view} 11 | 12 | \item{col}{selected columns to extract. Default is "auto" which will select all columns for 'ggplot' object and 'node' column for 'ggtree' object} 13 | 14 | \item{...}{additional parameters, normally ignored} 15 | } 16 | \value{ 17 | closest data point 18 | } 19 | \description{ 20 | identify node by interactive click 21 | } 22 | \author{ 23 | Guangchuang Yu 24 | } 25 | -------------------------------------------------------------------------------- /man/is-ggbreak.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{is.ggbreak} 4 | \alias{is.ggbreak} 5 | \title{is.ggbreak} 6 | \usage{ 7 | is.ggbreak(plot) 8 | } 9 | \arguments{ 10 | \item{plot}{a plot obejct} 11 | } 12 | \value{ 13 | logical value 14 | } 15 | \description{ 16 | check whether a plot is a ggbreak object (including 'ggbreak', 'ggwrap' and 'ggcut' that defined in the 'ggbreak' package) 17 | } 18 | \author{ 19 | Guangchuang Yu 20 | } 21 | -------------------------------------------------------------------------------- /man/is.ggtree.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{is.ggtree} 4 | \alias{is.ggtree} 5 | \title{is.ggtree} 6 | \usage{ 7 | is.ggtree(x) 8 | } 9 | \arguments{ 10 | \item{x}{object} 11 | } 12 | \value{ 13 | TRUE or FALSE 14 | } 15 | \description{ 16 | test whether input object is produced by ggtree function 17 | } 18 | \author{ 19 | Guangchuang Yu 20 | } 21 | -------------------------------------------------------------------------------- /man/keybox.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/keybox.R 3 | \name{keybox} 4 | \alias{keybox} 5 | \title{keybox} 6 | \usage{ 7 | keybox(p, grob = "roundrect", gp = NULL) 8 | } 9 | \arguments{ 10 | \item{p}{a ggplot object} 11 | 12 | \item{grob}{one of 'rect' or 'roundrect'} 13 | 14 | \item{gp}{graphic parameter} 15 | } 16 | \value{ 17 | grob object 18 | } 19 | \description{ 20 | draw border for each of the ggplot legends 21 | } 22 | \examples{ 23 | library(ggplot2) 24 | p <- ggplot(mtcars, aes(mpg, disp, color=factor(cyl), size=cyl)) + geom_point() 25 | keybox(p, 'roundrect', gp = gpar(col = '#808080', lty = "dashed")) 26 | } 27 | \author{ 28 | Guangchuang Yu 29 | } 30 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/method-identify.R, R/reexport.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{identify} 7 | \alias{gpar} 8 | \title{Objects exported from other packages} 9 | \keyword{internal} 10 | \description{ 11 | These objects are imported from other packages. Follow the links 12 | below to see their documentation. 13 | 14 | \describe{ 15 | \item{graphics}{\code{\link[graphics]{identify}}} 16 | 17 | \item{grid}{\code{\link[grid]{gpar}}} 18 | }} 19 | 20 | -------------------------------------------------------------------------------- /man/set_font.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/set_font.R 3 | \name{set_font} 4 | \alias{set_font} 5 | \title{set_font} 6 | \usage{ 7 | set_font(p, family = "sans", fontface = NULL, size = NULL, color = NULL) 8 | } 9 | \arguments{ 10 | \item{p}{ggplot object} 11 | 12 | \item{family}{font fammily} 13 | 14 | \item{fontface}{font face} 15 | 16 | \item{size}{font size} 17 | 18 | \item{color}{font color} 19 | } 20 | \value{ 21 | TableGrob object 22 | } 23 | \description{ 24 | setting font for ggplot (axis text, label, title, etc.) 25 | } 26 | \examples{ 27 | library(grid) 28 | library(ggplot2) 29 | d <- data.frame(x=rnorm(10), y=rnorm(10), lab=LETTERS[1:10]) 30 | p <- ggplot(d, aes(x, y)) + geom_text(aes(label=lab), size=5) 31 | set_font(p, family="Times", fontface="italic", color='firebrick') 32 | } 33 | \author{ 34 | Guangchuang Yu 35 | } 36 | -------------------------------------------------------------------------------- /man/set_point_legend_shape.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{set_point_legend_shape} 4 | \alias{set_point_legend_shape} 5 | \title{set_point_legend_shape} 6 | \usage{ 7 | set_point_legend_shape(plot) 8 | } 9 | \arguments{ 10 | \item{plot}{a 'gg' plot object} 11 | } 12 | \value{ 13 | an updated plot 14 | } 15 | \description{ 16 | override point legend set by 'aes(shape = I(shape))' 17 | } 18 | \author{ 19 | Guangchuang Yu 20 | } 21 | -------------------------------------------------------------------------------- /man/td_filter.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/treedata-function.R 3 | \name{td_filter} 4 | \alias{td_filter} 5 | \title{td-filter} 6 | \usage{ 7 | td_filter(..., .f = NULL) 8 | } 9 | \arguments{ 10 | \item{...}{Expressions that return a logical value.} 11 | 12 | \item{.f}{a function (if any, defaults to NULL) that pre-operate the data} 13 | } 14 | \value{ 15 | A function to filter ggtree plot data using conditions defined by '...'. 16 | } 17 | \description{ 18 | filter data for tree annotation layer 19 | } 20 | \details{ 21 | The 'td_filter()' function returns another function that can be 22 | used to subset ggtree() plot data. The function can be passed to the 'data' parameter 23 | of geom layer to perform subsetting. All rows that satisy your conditions will be retained. 24 | } 25 | \examples{ 26 | \dontrun{ 27 | tree <- rtree(30) 28 | ## similar to 'ggtree(tree) + geom_tippoint()' 29 | ggtree(tree) + geom_point(data = td_filter(isTip)) 30 | } 31 | } 32 | \references{ 33 | For more detailed demonstration of this function, please refer to chapter 12.5.1 of 34 | \emph{Data Integration, Manipulation and Visualization of Phylogenetic Trees} 35 | \url{http://yulab-smu.top/treedata-book/index.html} by Guangchuang Yu. 36 | } 37 | \seealso{ 38 | \link[dplyr:filter]{filter} 39 | } 40 | \author{ 41 | Guangchuang Yu 42 | } 43 | -------------------------------------------------------------------------------- /man/td_mutate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/treedata-function.R 3 | \name{td_mutate} 4 | \alias{td_mutate} 5 | \title{td-mutate} 6 | \usage{ 7 | td_mutate(..., .f = NULL) 8 | } 9 | \arguments{ 10 | \item{...}{additional parameters that pass to dplyr::mutate} 11 | 12 | \item{.f}{a function (if any, defaults to NULL) that pre-operate the data} 13 | } 14 | \value{ 15 | A function to mutate ggtree plot data 16 | } 17 | \description{ 18 | mutate data for tree annotation layer 19 | } 20 | \details{ 21 | The 'td_mutate()' function returns another function that can be 22 | used to mutate ggtree() plot data. The function can be passed to the 'data' parameter 23 | of geom layer to perform adding new variables and preserving existing ones. 24 | } 25 | \seealso{ 26 | \link[dplyr:mutate]{mutate} 27 | } 28 | -------------------------------------------------------------------------------- /man/td_unnest.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/treedata-function.R 3 | \name{td_unnest} 4 | \alias{td_unnest} 5 | \title{td-unnest} 6 | \usage{ 7 | td_unnest(cols, ..., .f = NULL) 8 | } 9 | \arguments{ 10 | \item{cols}{columns to unnest} 11 | 12 | \item{...}{additional parameters that pass to tidyr::unnest} 13 | 14 | \item{.f}{a function (if any, defaults to NULL) that pre-operate the data} 15 | } 16 | \value{ 17 | A function to unnest ggtree plot data 18 | } 19 | \description{ 20 | flatterns a list-column of data frame 21 | } 22 | \details{ 23 | The 'td_unnest' function returns another function that can be 24 | used to unnest ggtree() plot data. The function can be passed to 25 | the 'data' parameter of a geom layer to flattern list-cloumn tree data. 26 | } 27 | \references{ 28 | For demonstration of this function, please refer to chapter 12.5.2 of 29 | \emph{Data Integration, Manipulation and Visualization of Phylogenetic Trees} 30 | \url{http://yulab-smu.top/treedata-book/index.html} by Guangchuang Yu. 31 | } 32 | \seealso{ 33 | \link[tidyr:unnest]{unnest} 34 | } 35 | \author{ 36 | Guangchuang Yu 37 | } 38 | -------------------------------------------------------------------------------- /man/theme-no-axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme.R 3 | \name{theme_noxaxis} 4 | \alias{theme_noxaxis} 5 | \alias{theme_noyaxis} 6 | \alias{theme_noaxis} 7 | \title{theme_noxaxis} 8 | \usage{ 9 | theme_noxaxis(color = "black", ...) 10 | 11 | theme_noyaxis(color = "black", ...) 12 | 13 | theme_noaxis(...) 14 | } 15 | \arguments{ 16 | \item{color}{color of y-axis} 17 | 18 | \item{...}{additional parameters that passed to theme()} 19 | } 20 | \value{ 21 | ggplot2 theme 22 | } 23 | \description{ 24 | A theme that only show y-axis 25 | } 26 | \author{ 27 | Guangchuang Yu 28 | } 29 | -------------------------------------------------------------------------------- /man/theme_blinds.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme.R 3 | \name{theme_blinds} 4 | \alias{theme_blinds} 5 | \title{the theme of blind-like} 6 | \usage{ 7 | theme_blinds(colour = c("white", "grey"), axis = "y", ...) 8 | } 9 | \arguments{ 10 | \item{colour}{the colour of rectangular, default is c('white', 'grey60').} 11 | 12 | \item{axis}{character which grid of axis will be filled, default is 'y'.} 13 | 14 | \item{...}{additional parameters that passed to \code{theme} function.} 15 | } 16 | \value{ 17 | ggplot2 theme 18 | } 19 | \description{ 20 | the theme of blind-like 21 | } 22 | \examples{ 23 | library(ggplot2) 24 | iris |> tidyr::pivot_longer( 25 | cols = !Species, 26 | names_to = 'var', 27 | values_to = 'value' 28 | ) |> 29 | ggplot( 30 | aes(x=var, y=Species, color=value, size=value) 31 | ) + 32 | geom_point() -> p 33 | p + 34 | theme_blinds( 35 | colour = c('grey90', 'white'), 36 | axis = 'y', 37 | axis.line.y=element_line() 38 | ) 39 | p + 40 | theme_blinds( 41 | colour = c('grey90', 'white'), 42 | axis = 'x', 43 | axis.line.x = element_line() 44 | ) 45 | } 46 | -------------------------------------------------------------------------------- /man/theme_fp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme.R 3 | \name{theme_fp} 4 | \alias{theme_fp} 5 | \title{theme_fp} 6 | \usage{ 7 | theme_fp(x, i) 8 | } 9 | \arguments{ 10 | \item{x}{ggplot object to provide theme format} 11 | 12 | \item{i}{the element of a theme provided by \code{x}} 13 | } 14 | \value{ 15 | theme element 16 | } 17 | \description{ 18 | theme format painter 19 | } 20 | \details{ 21 | It applies theme element (i) from a ggplot (x) to another ggplot object 22 | } 23 | \author{ 24 | Guangchuang Yu and Shuangbin Xu 25 | } 26 | -------------------------------------------------------------------------------- /man/theme_no_margin.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme.R 3 | \name{theme_no_margin} 4 | \alias{theme_no_margin} 5 | \title{theme_no_margin} 6 | \usage{ 7 | theme_no_margin(...) 8 | } 9 | \arguments{ 10 | \item{...}{additional parameters that passed to theme()} 11 | } 12 | \value{ 13 | ggplot2 theme 14 | } 15 | \description{ 16 | A theme that has no margin 17 | } 18 | \author{ 19 | Guangchuang Yu 20 | } 21 | -------------------------------------------------------------------------------- /man/theme_nothing.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme.R 3 | \name{theme_nothing} 4 | \alias{theme_nothing} 5 | \title{theme_nothing} 6 | \usage{ 7 | theme_nothing(base_size = 11, base_family = "") 8 | } 9 | \arguments{ 10 | \item{base_size}{font size} 11 | 12 | \item{base_family}{font family} 13 | } 14 | \value{ 15 | ggplot2 theme 16 | } 17 | \description{ 18 | A theme that only show the plot panel 19 | } 20 | \author{ 21 | Guangchuang Yu 22 | } 23 | -------------------------------------------------------------------------------- /man/theme_stamp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme.R 3 | \name{theme_stamp} 4 | \alias{theme_stamp} 5 | \title{the theme of blind-like alias of theme_blinds} 6 | \usage{ 7 | theme_stamp(colour = c("white", "grey"), axis = "y", ...) 8 | } 9 | \arguments{ 10 | \item{colour}{the colour of rectangular, default is c('white', 'grey60').} 11 | 12 | \item{axis}{character which grid of axis will be filled, default is 'y'.} 13 | 14 | \item{...}{additional parameters that passed to \code{theme} function.} 15 | } 16 | \description{ 17 | the theme of blind-like alias of theme_blinds 18 | } 19 | -------------------------------------------------------------------------------- /man/theme_transparent.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme.R 3 | \name{theme_transparent} 4 | \alias{theme_transparent} 5 | \title{theme_transparent} 6 | \usage{ 7 | theme_transparent(...) 8 | } 9 | \arguments{ 10 | \item{...}{additional parameter to tweak the theme} 11 | } 12 | \value{ 13 | ggplot object 14 | } 15 | \description{ 16 | transparent background theme 17 | } 18 | \author{ 19 | Guangchuang Yu with contributions from Hugo Gruson 20 | } 21 | -------------------------------------------------------------------------------- /man/volplot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-volpoint.R 3 | \name{volplot} 4 | \alias{volplot} 5 | \title{volplot} 6 | \usage{ 7 | volplot(data, mapping, log2FC_cutoff = 2, p_cutoff = 1e-05, ...) 8 | } 9 | \arguments{ 10 | \item{data}{input data set} 11 | 12 | \item{mapping}{aesthetic mapping} 13 | 14 | \item{log2FC_cutoff}{cutoff values for log2FC} 15 | 16 | \item{p_cutoff}{cutoff values p-value or adjusted p-value} 17 | 18 | \item{...}{additional paramters passed to the 'geom_volpoint' layer} 19 | } 20 | \value{ 21 | a ggplot 22 | } 23 | \description{ 24 | volcano plot 25 | } 26 | -------------------------------------------------------------------------------- /vignettes/ggfun.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Useful functions for ggplot2" 3 | author: "Guangchuang Yu\\ 4 | 5 | School of Basic Medical Sciences, Southern Medical University" 6 | date: "`r Sys.Date()`" 7 | output: 8 | prettydoc::html_pretty: 9 | toc: true 10 | theme: cayman 11 | highlight: github 12 | pdf_document: 13 | toc: true 14 | vignette: > 15 | %\VignetteIndexEntry{ggplot utilities} 16 | %\VignetteEngine{knitr::rmarkdown} 17 | %\usepackage[utf8]{inputenc} 18 | --- 19 | 20 | ```{r style, echo=FALSE, results="asis", message=FALSE} 21 | knitr::opts_chunk$set(tidy = FALSE, 22 | message = FALSE) 23 | 24 | library("grid") 25 | library("ggplot2") 26 | library("ggfun") 27 | theme_set(theme_grey()) 28 | ``` 29 | 30 | 31 | ```{r} 32 | library("grid") 33 | library("ggplot2") 34 | library("ggfun") 35 | ``` 36 | 37 | ## element_roundrect 38 | 39 | 40 | 47 | 48 | The `element_roundrect` works like `element_rect` to draw round rectangle background. We can use it to adjust theme elements, including legend, strip, panel and plot background. 49 | 50 | ```{r} 51 | p <- ggplot(mpg, aes(displ, cty)) + geom_point() 52 | p <- p + facet_grid(cols = vars(cyl)) 53 | p <- p + theme(strip.background=element_roundrect(fill="grey40", color=NA, r=0.15)) 54 | p 55 | ``` 56 | 57 | ```{r} 58 | p2 <- ggplot(mtcars, aes(mpg, disp, color=factor(cyl), size=cyl)) + 59 | geom_point() 60 | p2 + theme(legend.background=element_roundrect(color="#808080", linetype=2)) 61 | ``` 62 | 63 | 64 | 65 | 66 | ## gglegend 67 | 68 | 69 | 70 | ```{r} 71 | p <- ggplot(mtcars, aes(mpg, disp)) + geom_point() 72 | data <- data.frame(colour = c("red", "blue"), VALUE = c("A", "B")) 73 | gglegend(aes(colour = VALUE, label=VALUE), data, geom_text, p) 74 | ``` 75 | 76 | 77 | ## set_font 78 | 79 | ```{r} 80 | d <- data.frame(x=rnorm(10), y=rnorm(10), lab=LETTERS[1:10]) 81 | p <- ggplot(d, aes(x, y)) + geom_text(aes(label=lab), size=5) 82 | set_font(p, family="Times", fontface="italic", color='firebrick') 83 | ``` 84 | 85 | ## facet_set 86 | 87 | Manually specifying facet labels. 88 | 89 | ```{r fig.width=6, fig.height=3} 90 | library(ggplot2) 91 | library(ggfun) 92 | p <- ggplot(mtcars, aes(disp, drat)) + 93 | geom_point() + 94 | facet_grid(cols=vars(am), rows=vars(cyl)) 95 | p + facet_set(label=c(`0`="Zero", `6`="Six")) 96 | ``` 97 | 98 | Supports labeller: 99 | 100 | ```{r} 101 | p + facet_set(label=label_both) 102 | ``` 103 | 104 | 105 | Add a facet label to a plot. 106 | 107 | ```{r} 108 | p + facet_set(label="TEST") 109 | ``` 110 | 111 | With the [ggplotify](https://cran.r-project.org/package=ggplotify) package, we can use `facet_set` to add a facet label to almost any plot in R. 112 | 113 | ```{r eval=FALSE} 114 | ## please try: 115 | 116 | ggplotify::as.ggplot(~barplot(1:10, col=rainbow(10))) + 117 | facet_set('a barplot in base') 118 | ``` 119 | --------------------------------------------------------------------------------