├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── R ├── add-link-extra-params.R ├── add-link-utils.R ├── add-link.R ├── as-cor-network.R ├── as-cor-tbl.R ├── as-igraph.R ├── as-matrix.R ├── as-tbl-graph.R ├── colour-pal-utils.R ├── cor-network.R ├── cor-tbl-utils.R ├── cor-tbl.R ├── cor-test.R ├── create-layout.R ├── display-cor.R ├── dplyr.R ├── draw-key.R ├── expand-axis.R ├── export-cor-network.R ├── fortify-cor.R ├── fortify-mantel.R ├── geom-circle2.R ├── geom-colour.R ├── geom-conf.R ├── geom-cross.R ├── geom-diag-label.R ├── geom-ellipse2.R ├── geom-hc-rect.R ├── geom-link.R ├── geom-link2.R ├── geom-mark.R ├── geom-num.R ├── geom-panel-grid.R ├── geom-pie2.R ├── geom-ring.R ├── geom-shade.R ├── geom-square.R ├── geom-star.R ├── get-data.R ├── ggcor.R ├── guide-colourbar2.R ├── matrix-order.R ├── quickcor.R ├── reexport.R ├── remove-axis.R ├── scale-gradient2n.R ├── scale-radius.R ├── theme-cor.R ├── triangle-colour-scale.R ├── utils.R └── zzz.R ├── README.Rmd ├── ggcor.Rproj ├── man ├── add_link.Rd ├── as_cor_network.Rd ├── as_cor_tbl.Rd ├── as_igraph.Rd ├── as_matrix.Rd ├── as_tbl_graph.Rd ├── colour-pal.Rd ├── cor-network.Rd ├── cor_tbl.Rd ├── corrlate.Rd ├── create-layout.Rd ├── display_cor.Rd ├── expand_axis.Rd ├── export_cor_network.Rd ├── extra_params.Rd ├── extract_cor_tbl.Rd ├── figures │ ├── README-example01-1.png │ ├── README-example01-2.png │ ├── README-example01-3.png │ ├── README-example02-1.png │ ├── README-example03-1.png │ ├── README-example03-2.png │ ├── README-pressure-1.png │ ├── README-unnamed-chunk-2-1.png │ ├── README-unnamed-chunk-3-1.png │ └── README-unnamed-chunk-4-1.png ├── fortify_cor.Rd ├── fortify_mantel.Rd ├── geom_circle2.Rd ├── geom_colour.Rd ├── geom_confbox.Rd ├── geom_cross.Rd ├── geom_diag_label.Rd ├── geom_ellipse2.Rd ├── geom_hc_rect.Rd ├── geom_link.Rd ├── geom_link2.Rd ├── geom_mark.Rd ├── geom_number.Rd ├── geom_panel_grid.Rd ├── geom_ring.Rd ├── geom_shade.Rd ├── geom_square.Rd ├── geom_star.Rd ├── get_attr.Rd ├── get_data.Rd ├── ggcor.Rd ├── guide_colourbar2.Rd ├── link_params.Rd ├── mantel_test.Rd ├── matrix_order.Rd ├── point_params.Rd ├── print.correlate.Rd ├── quick_cor.Rd ├── reexports.Rd ├── remove_axis.Rd ├── scale_colour.Rd ├── scale_radius.Rd ├── scale_upper_colour.Rd ├── scale_upper_fill.Rd ├── text_params.Rd └── theme_cor.Rd └── readme.md /.Rbuildignore: -------------------------------------------------------------------------------- 1 | 2 | \.git 3 | \.Rhistory 4 | \.Rcheck 5 | ^.*\.Rproj$ 6 | ^\.Rproj\.user$ 7 | ^README\.Rmd$ 8 | ^readme\.md$ 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rapp.history 2 | .swp 3 | .DS_Store 4 | .Rproj.user 5 | .Rhistory 6 | .RData 7 | .Ruserdata 8 | inst/doc 9 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggcor 2 | Type: Package 3 | Title: Extended tools for correlation analysis and visualization 4 | Version: 0.9.4.3 5 | Authors@R: c( 6 | person("Houyun", "Huang", email = "houyunhuang@163.com", role = c("aut", "cre")), 7 | person("Lei", "Zhou", email = "zhoulei@scau.edu.cn", role = "aut"), 8 | person("Jian", "Chen", email = "cafchenjian@163.com", role = "aut"), 9 | person("Taiyun", "Wei", email = "weitaiyun@gmail.com", role = "aut")) 10 | Maintainer: Houyun Huang 11 | Description: The 'ggcor' package can be used to visualize simply and directly a 12 | correlation matrix based on 'ggplot2'. It provides a solution for reordering the 13 | correlation matrix, displaying the different significance level on the plot and 14 | other details. The most important parts, It also provides a graphical display of 15 | any correlation analysis and their combination (such as Mantel test, Partial 16 | correlation analysis, and so on). 17 | License: GPL-2 18 | URL: https://github.com/houyunhuang/ggcor 19 | BugReports: https://github.com/houyunhuang/ggcor/issues 20 | LazyData: TRUE 21 | Encoding: UTF-8 22 | Depends: 23 | R (>= 3.5.0) 24 | Imports: 25 | grid, 26 | ade4, 27 | dplyr, 28 | digest, 29 | ggplot2 (>= 3.0.0), 30 | igraph, 31 | purrr, 32 | RColorBrewer, 33 | rlang, 34 | scales, 35 | stats, 36 | tibble, 37 | tidygraph, 38 | utils, 39 | vegan 40 | Suggests: 41 | ggraph, 42 | knitr, 43 | latex2exp, 44 | rmarkdown, 45 | picante, 46 | WGCNA 47 | RoxygenNote: 7.0.2 48 | VignetteBuilder: knitr 49 | Collate: 50 | 'add-link-extra-params.R' 51 | 'add-link-utils.R' 52 | 'add-link.R' 53 | 'as-cor-network.R' 54 | 'as-cor-tbl.R' 55 | 'as-igraph.R' 56 | 'as-matrix.R' 57 | 'as-tbl-graph.R' 58 | 'colour-pal-utils.R' 59 | 'cor-network.R' 60 | 'cor-tbl.R' 61 | 'cor-tbl-utils.R' 62 | 'cor-test.R' 63 | 'create-layout.R' 64 | 'display-cor.R' 65 | 'dplyr.R' 66 | 'draw-key.R' 67 | 'expand-axis.R' 68 | 'export-cor-network.R' 69 | 'fortify-cor.R' 70 | 'fortify-mantel.R' 71 | 'geom-circle2.R' 72 | 'geom-colour.R' 73 | 'geom-conf.R' 74 | 'geom-cross.R' 75 | 'geom-diag-label.R' 76 | 'geom-ellipse2.R' 77 | 'geom-hc-rect.R' 78 | 'geom-link.R' 79 | 'geom-link2.R' 80 | 'geom-mark.R' 81 | 'geom-num.R' 82 | 'geom-panel-grid.R' 83 | 'geom-pie2.R' 84 | 'geom-ring.R' 85 | 'geom-shade.R' 86 | 'geom-square.R' 87 | 'geom-star.R' 88 | 'get-data.R' 89 | 'ggcor.R' 90 | 'guide-colourbar2.R' 91 | 'matrix-order.R' 92 | 'quickcor.R' 93 | 'reexport.R' 94 | 'remove-axis.R' 95 | 'scale-gradient2n.R' 96 | 'scale-radius.R' 97 | 'triangle-colour-scale.R' 98 | 'theme-cor.R' 99 | 'utils.R' 100 | 'zzz.R' 101 | -------------------------------------------------------------------------------- /R/add-link-extra-params.R: -------------------------------------------------------------------------------- 1 | #' Extra params for add_link 2 | #' @description This function is used to control the details 3 | #' of the link, including the location, shape, size, color 4 | #' of points, and font size, font color, and so on of the 5 | #' text label. 6 | #' @param spec.label NULL or "text_params" object producing by 7 | #' \code{\link[ggcor]{text_params}}. 8 | #' @param spec.point NULL or "point_params" object producing by 9 | #' \code{\link[ggcor]{point_params}}. 10 | #' @param env.point NULL or "point_params" object producing by 11 | #' \code{\link[ggcor]{point_params}}. 12 | #' @param link.params "point_params" object producing by \code{\link[ggcor]{point_params}}. 13 | #' @rdname extra_params 14 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 15 | #' @export 16 | extra_params <- function(spec.label = text_params(), 17 | spec.point = point_params(fill = "blue"), 18 | env.point = point_params(fill = "grey60"), 19 | link.params = link_params()) 20 | { 21 | if(!inherits(spec.label, "text_params") && !is.null(spec.label)) 22 | stop("Element 'spec.label' must be a text_params object or NULL.", call. = FALSE) 23 | if(!inherits(spec.point, "point_params") && is.null(spec.point)) 24 | stop("Element 'spec.point' must be a point_params object or NULL.", call. = FALSE) 25 | if(!inherits(env.point, "point_params") && is.null(env.point)) 26 | stop("Element 'env.point' must be a point_params object or NULL.", call. = FALSE) 27 | if(!inherits(link.params, "link_params")) 28 | stop("Element 'link.params' must be a link_params object.", call. = FALSE) 29 | structure(list(spec.label = spec.label, 30 | spec.point = spec.point, 31 | env.point = env.point, 32 | link.params = link.params 33 | ), 34 | class = "extra_params") 35 | } 36 | 37 | #' Extra text label params 38 | #' @description This is mainly used in the add_link function to set the group label. 39 | #' @param colour,color colour of text. 40 | #' @param size font size of text. 41 | #' @param angle angle to rotate the text. 42 | #' @param hjust,vjust a numeric vector specifying horizontal/vertical justification. 43 | #' @param alpha alpha channel for transparency. 44 | #' @param family the font family. 45 | #' @param fontface the font face. 46 | #' @rdname text_params 47 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 48 | #' @export 49 | text_params <- function(colour = "black", size = 3.88, angle = 0, hjust = NULL, 50 | vjust = 0.5, alpha = NA, family = "", fontface = 1, color = NULL) 51 | { 52 | if (!is.null(color)) colour <- color 53 | structure(list(colour = colour, size = size, angle = angle, hjust = hjust, 54 | vjust = vjust, alpha = alpha, family = family, fontface = fontface), 55 | class = "text_params") 56 | } 57 | 58 | #' Extra points params 59 | #' @description This is mainly used in the add_link function to control points style. 60 | #' @param alpha alpha channel for transparency. 61 | #' @param colour,color colour of points. 62 | #' @param fill fill colour of points. 63 | #' @param shape shape of points. 64 | #' @param size size of points. 65 | #' @param stroke stroke of points. 66 | #' @rdname point_params 67 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 68 | #' @export 69 | point_params <- function(alpha = NA, colour = "black", fill = NA, shape = 21, 70 | size = 1, stroke = 0.5, color = NULL) 71 | { 72 | if (!is.null(color)) colour <- color 73 | structure(list(alpha = alpha, colour = colour, fill = fill, 74 | shape = shape, size = size, stroke = stroke), 75 | class = "point_params") 76 | } 77 | 78 | #' Control the points position of link 79 | #' @description This is mainly used in the add_link function to control points position. 80 | #' @param env.point.hjust,env.point.vjust a numeric vector is used to set the distance that 81 | #' points (close to the correlation matrix) moves horizontally or vertically. 82 | #' @param spec.point.hjust,spec.point.vjust a numeric vector is used to set the distance that 83 | #' points (away from the correlation matrix) moves horizontally or vertically. 84 | #' @rdname link_params 85 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 86 | #' @export 87 | link_params <- function(env.point.hjust = NULL, env.point.vjust = NULL, 88 | spec.point.hjust = NULL, spec.point.vjust = NULL) 89 | { 90 | structure(list(env.point.hjust = env.point.hjust, 91 | env.point.vjust = env.point.vjust, 92 | spec.point.hjust = spec.point.hjust, 93 | spec.point.vjust = spec.point.vjust), 94 | class = "link_params") 95 | } 96 | -------------------------------------------------------------------------------- /R/as-cor-tbl.R: -------------------------------------------------------------------------------- 1 | #' Coerce to a cor_tbl object 2 | #' @description Functions to coerce a object to cor_tbl if possible. 3 | #' @param x any \code{R} object. 4 | #' @param extra.mat any other matrix-like data with same dimmsion as \code{x}. 5 | #' @param byrow a logical value indicating whether arrange the 'spec' columns on y axis. 6 | #' @param ... extra params passing to \code{\link[ggcor]{cor_tbl}}. 7 | #' @return a cor_tbl object. 8 | #' @importFrom utils modifyList 9 | #' @rdname as_cor_tbl 10 | #' @examples 11 | #' cor(mtcars) %>% as_cor_tbl() 12 | #' correlate(mtcars, cor.test = TRUE) %>% as_cor_tbl() 13 | #' correlate(mtcars, type = "upper") %>% as_cor_tbl() 14 | #' \dontrun{ 15 | #' ## S3 method for rcorr object 16 | #' require(Hmisc) 17 | #' rcorr(mtcars) %>% as_cor_tbl() 18 | #' 19 | #' ## S3 method for corr.test object 20 | #' require(psych) 21 | #' corr.test(mtcars) %>% as_cor_tbl() 22 | #' } 23 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 24 | #' @export 25 | as_cor_tbl <- function(x, ...) { 26 | UseMethod("as_cor_tbl") 27 | } 28 | 29 | #' @rdname as_cor_tbl 30 | #' @export 31 | #' @method as_cor_tbl matrix 32 | as_cor_tbl.matrix <- function(x, ...) { 33 | cor_tbl(corr = x, ...) 34 | } 35 | #' @rdname as_cor_tbl 36 | #' @export 37 | #' @method as_cor_tbl data.frame 38 | as_cor_tbl.data.frame <- function(x, ...) { 39 | cor_tbl(corr = x, ...) 40 | } 41 | 42 | #' @rdname as_cor_tbl 43 | #' @export 44 | #' @method as_cor_tbl correlate 45 | as_cor_tbl.correlate <- function(x, extra.mat = list(), ...) { 46 | anynull <- is.null(x$lower.ci) || is.null(x$upper.ci) 47 | conf.ci <- if(!anynull) { 48 | list(upper.ci = x$upper.ci, lower.ci = x$lower.ci) 49 | } else list() 50 | extra.mat <- modifyList(extra.mat, conf.ci) 51 | cor_tbl(corr = x$r, p.value = x$p.value, extra.mat = extra.mat, ...) 52 | } 53 | 54 | #' @rdname as_cor_tbl 55 | #' @export 56 | #' @method as_cor_tbl rcorr 57 | as_cor_tbl.rcorr <- function(x, ...) 58 | { 59 | p.value <- x$P 60 | diag(p.value) <- 0 61 | cor_tbl(corr = x$r, p.value = p.value, ...) 62 | } 63 | 64 | #' @rdname as_cor_tbl 65 | #' @export 66 | #' @method as_cor_tbl corr.test 67 | as_cor_tbl.corr.test <- function(x, ...) 68 | { 69 | cor_tbl(corr = x$r, p.value = x$p, ...) 70 | } 71 | #' @rdname as_cor_tbl 72 | #' @export 73 | #' @method as_cor_tbl mantel_tbl 74 | as_cor_tbl.mantel_tbl <- function(x, byrow = TRUE, ...) { 75 | env_nm <- unique(x$env) 76 | spec_nm <- unique(x$spec) 77 | if(byrow) { 78 | col.names <- env_nm 79 | row.names <- spec_nm 80 | .col.names <- x$env 81 | .row.names <- x$spec 82 | .col.id <- as.integer(factor(x$env, levels = col.names)) 83 | .row.id <- as.integer(factor(x$spec, levels = rev(row.names))) 84 | } else { 85 | col.names <- spec_nm 86 | row.names <- env_nm 87 | .col.names <- x$spec 88 | .row.names <- x$env 89 | .col.id <- as.integer(factor(x$spec, levels = col.names)) 90 | .row.id <- as.integer(factor(x$env, levels = rev(row.names))) 91 | } 92 | df <- tibble::tibble(.col.names = .col.names, .row.names = .row.names, 93 | r = x$r, p.value = x$p.value, .row.id = .row.id, 94 | .col.id = .col.id) %>% 95 | dplyr::bind_cols(x[setdiff(names(x), c("spec", "env", "r", "p.value"))]) 96 | structure( 97 | .Data = df, 98 | .row.names = row.names, 99 | .col.names = col.names, 100 | type = "full", 101 | show.diag = TRUE, 102 | grouped = attr(x, "grouped"), 103 | class = c("cor_tbl", setdiff(class(df), "mantel_tbl")) 104 | ) 105 | } 106 | #' @rdname as_cor_tbl 107 | #' @export 108 | #' @method as_cor_tbl default 109 | as_cor_tbl.default <- function(x, ...) { 110 | stop(class(x)[1], " hasn't been realized yet.", call. = FALSE) 111 | } 112 | 113 | #' @noRd 114 | check_dimension <- function(x, y) { 115 | x_nm <- as.character(match.call()[["x"]]) 116 | y_nm <- as.character(match.call()[["y"]]) 117 | if(any(dim(x) != dim(y))) { 118 | msg <- paste0(" Dimension error: ", y_nm, " must have same dimension as ", x_nm) 119 | stop(msg, call. = FALSE) 120 | } 121 | } 122 | -------------------------------------------------------------------------------- /R/as-igraph.R: -------------------------------------------------------------------------------- 1 | #' Corece to a igraph object 2 | #' @description Functions to coerce a object to igraph if possible. 3 | #' @param x \code{R} object. 4 | #' @param directed logical value, whether or not to create a directed graph. 5 | #' @param ... extra params. 6 | #' @return igraph object. 7 | #' @importFrom igraph graph_from_data_frame as.igraph 8 | #' @rdname as_igraph 9 | #' @examples 10 | #' fortify_cor(mtcars) %>% as.igraph() 11 | #' correlate(mtcars, cor.test = TRUE) %>% as.igraph() 12 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 13 | #' @export 14 | as.igraph.cor_tbl <- function(x, directed = FALSE, ...) 15 | { 16 | x <- as_cor_network(x, ...) 17 | igraph::graph_from_data_frame(x$edges, directed = directed, 18 | vertices = x$nodes) 19 | } 20 | 21 | #' @rdname as_igraph 22 | #' @export 23 | as.igraph.mantel_tbl <- function(x, directed = FALSE, ...) 24 | { 25 | as.igraph(as_cor_tbl(x), directed = directed, ...) 26 | } 27 | 28 | #' @rdname as_igraph 29 | #' @importFrom tidygraph tbl_graph 30 | #' @export 31 | as.igraph.rcorr <- function(x, directed = FALSE, ...) 32 | { 33 | p.value <- x$P 34 | diag(p.value) <- 0 35 | cor_network(x$r, p.value, directed = directed, ..., val.type = "igraph") 36 | } 37 | 38 | #' @rdname as_igraph 39 | #' @export 40 | as.igraph.corr.test <- function(x, directed = FALSE, ...) 41 | { 42 | cor_network(x$r, x$p, directed = directed, ..., val.type = "igraph") 43 | } 44 | 45 | #' @rdname as_igraph 46 | #' @export 47 | as.igraph.correlate <- function(x, directed = FALSE, ...) 48 | { 49 | cor_network(x$r, x$p.value, directed = directed, ..., val.type = "igraph") 50 | } 51 | 52 | #' @importFrom igraph graph_from_data_frame 53 | #' @rdname as_igraph 54 | #' @export 55 | as.igraph.cor_network <- function(x, directed = FALSE, ...) 56 | { 57 | igraph::graph_from_data_frame(x$edges, directed, x$nodes) 58 | } 59 | -------------------------------------------------------------------------------- /R/as-matrix.R: -------------------------------------------------------------------------------- 1 | #' Convert a object to matrix 2 | #' @description Functions to convert cor_tbl object to a list of matrix. 3 | #' @param x any \code{R} object. 4 | #' @param index character vector indicating which columns will be convert. If "all", 5 | #' all columns will be convert. 6 | #' @param missing If NULL (default), the missing value will be filled with NAs. 7 | #' @param ... extra params. 8 | #' @return a list of matrix. 9 | #' @importFrom purrr walk walk2 10 | #' @importFrom rlang set_names 11 | #' @importFrom dplyr filter 12 | #' @rdname as_matrix 13 | #' @examples 14 | #' cor(mtcars) %>% as_cor_tbl() %>% as_matrix() 15 | #' cor(mtcars) %>% as_cor_tbl() %>% as_matrix("r") 16 | #' fortify_cor(iris[-5],group = iris$Species, cor.test = TRUE) %>% 17 | #' as_matrix() 18 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 19 | #' @export 20 | as_matrix <- function(x, ...) { 21 | UseMethod("as_matrix") 22 | } 23 | 24 | #' @rdname as_matrix 25 | #' @export 26 | #' @method as_matrix cor_tbl 27 | as_matrix.cor_tbl <- function(x, 28 | index = "all", 29 | missing = NULL, 30 | ...) { 31 | if(length(index) == 1 && index == "all") { 32 | index <- setdiff(names(x), c(".row.names", ".col.names", ".row.id", ".col.id", 33 | ".group")) 34 | } 35 | row.name <- get_row_name(x) 36 | col.name <- get_col_name(x) 37 | if(is.null(missing)) { 38 | mat <- matrix(nrow = length(row.name), ncol = length(col.name), 39 | dimnames = list(row.name, col.name)) 40 | } else { 41 | mat <- matrix(missing, nrow = length(row.name), ncol = length(col.name), 42 | dimnames = list(row.name, col.name)) 43 | } 44 | 45 | mat <- rlang::set_names(rep_len(list(mat), length(index)), index) 46 | if(isTRUE(attr(x, "grouped"))) { 47 | group <- unique(x$.group) 48 | mat <- rlang::set_names(rep_len(list(mat), length(group)), group) 49 | purrr::walk(group, function(.grp) { 50 | purrr::walk(index, function(.index){ 51 | purrr::walk2(x$.row.id, x$.col.id, function(.row, .col) { 52 | temp <- dplyr::filter(x, .row.id == .row, .col.id == .col, .group == .grp) 53 | mat[[.grp]][[.index]][length(row.name) - .row + 1, .col] <<- temp[[.index]] 54 | }) 55 | }) 56 | }) 57 | } else { 58 | purrr::walk(index, function(.index){ 59 | purrr::walk2(x$.row.id, x$.col.id, function(.row, .col) { 60 | temp <- dplyr::filter(x, .row.id == .row, .col.id == .col) 61 | mat[[.index]][length(row.name) - .row + 1, .col] <<- temp[[.index]] 62 | }) 63 | }) 64 | } 65 | return(mat) 66 | } 67 | 68 | #' @rdname as_matrix 69 | #' @export 70 | #' @method as_matrix mantel_tbl 71 | as_matrix.mantel_tbl <- function(x, ...) { 72 | as_matrix(as_cor_tbl(x), ...) 73 | } 74 | 75 | -------------------------------------------------------------------------------- /R/as-tbl-graph.R: -------------------------------------------------------------------------------- 1 | #' Corece to a graph_tbl object 2 | #' @description Functions to coerce a object to graph_tbl if possible. 3 | #' @param x \code{R} object. 4 | #' @param directed logical value, whether or not to create a directed graph. 5 | #' @param ... extra params. 6 | #' @return tbl_graph object. 7 | #' @importFrom tidygraph tbl_graph as_tbl_graph 8 | #' @rdname as_tbl_graph 9 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 10 | #' @export 11 | as_tbl_graph.cor_tbl <- function(x, directed = FALSE, ...) 12 | { 13 | x <- as_cor_network(x, ...) 14 | tidygraph::tbl_graph(nodes = x$nodes, 15 | edges = x$edges, directed = directed) 16 | } 17 | 18 | 19 | #' @rdname as_tbl_graph 20 | #' @export 21 | as_tbl_graph.mantel_tbl <- function(x, directed = FALSE, ...) 22 | { 23 | as_tbl_graph(as_cor_tbl(x), directed = directed, ...) 24 | } 25 | 26 | #' @rdname as_tbl_graph 27 | #' @export 28 | as_tbl_graph.rcorr <- function(x, directed = FALSE, ...) 29 | { 30 | p.value <- x$P 31 | diag(p.value) <- 0 32 | cor_network(x$r, p.value, directed = directed, ..., val.type = "tbl_graph") 33 | } 34 | 35 | #' @rdname as_tbl_graph 36 | #' @export 37 | as_tbl_graph.corr.test <- function(x, directed = FALSE, ...) 38 | { 39 | cor_network(x$r, x$p, directed = directed, ..., val.type = "tbl_graph") 40 | } 41 | 42 | #' @rdname as_tbl_graph 43 | #' @export 44 | as_tbl_graph.correlate <- function(x, directed = FALSE, ...) 45 | { 46 | cor_network(x$r, x$p.value, directed = directed, ..., val.type = "tbl_graph") 47 | } 48 | 49 | #' @importFrom tidygraph tbl_graph 50 | #' @rdname as_tbl_graph 51 | #' @export 52 | as_tbl_graph.cor_network <- function(x, ...) 53 | { 54 | directed <- attr(x, "directed") 55 | tidygraph::tbl_graph(nodes = x$nodes, edges = x$edges, 56 | directed = directed %||% FALSE) 57 | } 58 | -------------------------------------------------------------------------------- /R/colour-pal-utils.R: -------------------------------------------------------------------------------- 1 | #' Colour pal 2 | #' @description Wrapper for the diverging palettes provided by \code{\link{RColorBrewer}}. 3 | #' @param n number of different colors in the palette, minimum 3, maximum 11. 4 | #' @return a palette. 5 | #' @rdname colour-pal 6 | #' @export 7 | brown_blue <- function(n = 11) { 8 | RColorBrewer::brewer.pal(n, "BrBG") 9 | } 10 | #' @rdname colour-pal 11 | #' @export 12 | pink_green <- function(n = 11) { 13 | RColorBrewer::brewer.pal(n, "PiYG") 14 | } 15 | #' @rdname colour-pal 16 | #' @export 17 | purple_green <- function(n = 11) { 18 | RColorBrewer::brewer.pal(n, "PRGn") 19 | } 20 | #' @rdname colour-pal 21 | #' @export 22 | brown_purple <- function(n = 11) { 23 | RColorBrewer::brewer.pal(n, "PuOr") 24 | } 25 | #' @rdname colour-pal 26 | #' @export 27 | red_blue <- function(n = 11) { 28 | RColorBrewer::brewer.pal(n, "RdBu") 29 | } 30 | #' @rdname colour-pal 31 | #' @export 32 | red_grey <- function(n = 11) { 33 | RColorBrewer::brewer.pal(n, "RdGy") 34 | } 35 | #' @rdname colour-pal 36 | #' @export 37 | red_yellow_blue <- function(n = 11) { 38 | RColorBrewer::brewer.pal(n, "RdYlBu") 39 | } 40 | #' @rdname colour-pal 41 | #' @export 42 | red_yellow_green <- function(n = 11) { 43 | RColorBrewer::brewer.pal(n, "RdYlGn") 44 | } 45 | #' @rdname colour-pal 46 | #' @export 47 | spectral <- function(n = 11) { 48 | RColorBrewer::brewer.pal(n, "Spectral") 49 | } 50 | #' @rdname colour-pal 51 | #' @export 52 | link_colour_pal <- function(n) 53 | { 54 | stopifnot(n <= 6) 55 | colors <- c("#D95F02", "#1B9E77", "#7570B3", 56 | "#E7298A", "#A6761D", "#F2F2F2") 57 | if(n == 1) 58 | return(colors[1]) 59 | col <- c(colors[1:(n - 1)], colors[6]) 60 | col 61 | 62 | } 63 | -------------------------------------------------------------------------------- /R/cor-network.R: -------------------------------------------------------------------------------- 1 | #' Tidy co-occurrence network data 2 | #' @description The function calculates correlation coefficient, statistical 3 | #' significance level and filters according to conditions. 4 | #' @param x a cor_network object. 5 | #' @param corr correlation matrix. 6 | #' @param p.value significant matrix of correlation. 7 | #' @param directed logical value, whether or not to create a directed graph. 8 | #' @param row.names,col.names row and column names of correlation matrix. 9 | #' @param rm.dup logical (defaults to TRUE) indicating whether remove duplicate 10 | #' rows. If TRUE, the correlation between A-B and B-A is retained only A-B. 11 | #' @param simplify logical value (defaults to TRUE) indicating whether to 12 | #' delete nodes without edge connections. 13 | #' @param weight NULL (default) or name of column in edges which will be renamed 14 | #' to "weight". 15 | #' @param r.thres a numeric value. 16 | #' @param r.absolute logical value (defaults to TRUE). 17 | #' @param p.thres a numeric value. 18 | #' @param val.type type return value: 19 | #' \itemize{ 20 | #' \item \code{tbl_graph}: return tbl_graph object 21 | #' \item \code{igraph}: return igraph object 22 | #' \item \code{list}: return a list of nodes and edges 23 | #' } 24 | #' @param n number of rows to show. 25 | #' @param ... extra params for printing. 26 | #' @return a tbl_graph (default), igraph or list object. 27 | #' @importFrom dplyr filter rename %>% 28 | #' @importFrom tibble tibble 29 | #' @importFrom tidygraph tbl_graph 30 | #' @importFrom igraph graph_from_data_frame 31 | #' @importFrom rlang sym !! 32 | #' @rdname cor-network 33 | #' @examples 34 | #' cor_network(cor(mtcars)) 35 | #' corr <- correlate(mtcars, cor.test = TRUE) 36 | #' cor_network(corr$r, corr$p.value) 37 | #' 38 | #' ## return a igraph object 39 | #' cor_network(corr$r, corr$p.value, val.type = "igraph") 40 | #' 41 | #' ## reurn a tbl_graph object 42 | #' cor_network(corr$r, corr$p.value, val.type = "tbl_graph") 43 | #' 44 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 45 | #' @export 46 | cor_network <- function(corr, 47 | p.value = NULL, 48 | directed = FALSE, 49 | row.names = NULL, 50 | col.names = NULL, 51 | rm.dup = TRUE, 52 | simplify = TRUE, 53 | weight = NULL, 54 | r.thres = 0.6, 55 | r.absolute = TRUE, 56 | p.thres = 0.05, 57 | val.type = "tbl_graph") 58 | { 59 | val.type <- match.arg(val.type, c("tbl_graph", "igraph", "list")) 60 | if(!is.matrix(corr)) 61 | corr <- as.matrix(corr) 62 | if(!is.null(p.value) && !is.matrix(p.value)) 63 | p.value <- as.matrix(p.value) 64 | .row.names <- row.names %||% rownames(corr) %||% paste0("row", 1:nrow(corr)) 65 | .col.names <- col.names %||% colnames(corr) %||% paste0("col", 1:ncol(corr)) 66 | is.symmet <- length(.row.names) == length(.col.names) && all(.row.names == .col.names) 67 | 68 | edges <- tibble::tibble(from = rep(.row.names, ncol(corr)), 69 | to = rep(.col.names, each = nrow(corr)), 70 | r = as.vector(corr)) 71 | if(!is.null(p.value)) 72 | edges$p.value <- as.vector(p.value) 73 | if(is.symmet && rm.dup) { 74 | edges <- dplyr::filter(edges, lower.tri(corr)) 75 | } 76 | edges <- if(is.finite(r.thres)) { 77 | if(r.absolute) { 78 | if(is.null(p.value) || !is.finite(p.thres)) { 79 | dplyr::filter(edges, abs(r) > r.thres) 80 | } else { 81 | dplyr::filter(edges, abs(r) > r.thres, p.value < p.thres) 82 | } 83 | } else { 84 | if(is.null(p.value) || !is.finite(p.thres)) { 85 | dplyr::filter(edges, r > r.thres) 86 | } else { 87 | dplyr::filter(edges, r > r.thres, p.value < p.thres) 88 | } 89 | } 90 | } else { 91 | if(is.null(p.value) || !is.finite(p.thres)) { 92 | edges 93 | } else { 94 | dplyr::filter(edges, p.value < p.thres) 95 | } 96 | } 97 | nodes <- if(simplify) { 98 | tibble::tibble(name = unique(c(edges$from, edges$to))) 99 | } else { 100 | tibble::tibble(name = unique(c(.row.names, .col.names))) 101 | } 102 | 103 | if(!is.null(weight)) { 104 | if(!weight %in% names(edges)) { 105 | stop("don't find ", weight, " in egdes table.", call. = FALSE) 106 | } 107 | weight <- rlang::sym(weight) 108 | edges <- dplyr::rename(edges, weight = !!weight) 109 | } 110 | 111 | switch (val.type, 112 | tbl_graph = tidygraph::tbl_graph(nodes = nodes, edges = edges, directed = directed), 113 | igraph = igraph::graph_from_data_frame(edges, directed = directed, vertices = nodes), 114 | list = structure(.Data = list(nodes = nodes, edges = edges), 115 | directed = directed, class = "cor_network") 116 | ) 117 | } 118 | 119 | #' @rdname cor-network 120 | #' @export 121 | print.cor_network <- function(x, n = 3, ...) 122 | { 123 | cat("A cor_network object:", "\n") 124 | cat("Nodes table: ") 125 | print(x$nodes, n = n, ...) 126 | cat("Edges table: ") 127 | print(x$edges, n = n, ...) 128 | } 129 | -------------------------------------------------------------------------------- /R/cor-tbl-utils.R: -------------------------------------------------------------------------------- 1 | #' Helper function of cor_tbl 2 | #' @param x a cor_tbl. 3 | #' @return return attribute value. 4 | #' @rdname get_attr 5 | #' @examples 6 | #' df <- fortify_cor(mtcars) 7 | #' ## get rows names 8 | #' get_row_name(df) 9 | #' 10 | #' ## get columns names 11 | #' get_col_name(df) 12 | #' 13 | #' ## get show.diag parameter 14 | #' get_show_diag(df) 15 | #' 16 | #' ## get type parameter 17 | #' get_type(df) 18 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 19 | #' @export 20 | get_row_name <- function(x) { 21 | stopifnot(is_cor_tbl(x)) 22 | attr(x, ".row.names") 23 | } 24 | 25 | #' @rdname get_attr 26 | #' @export 27 | get_col_name <- function(x) { 28 | stopifnot(is_cor_tbl(x)) 29 | attr(x, ".col.names") 30 | } 31 | 32 | #' @rdname get_attr 33 | #' @export 34 | get_type <- function(x) { 35 | stopifnot(is_cor_tbl(x)) 36 | attr(x, "type") 37 | } 38 | 39 | #' @rdname get_attr 40 | #' @export 41 | get_show_diag <- function(x) { 42 | stopifnot(is_cor_tbl(x)) 43 | attr(x, "show.diag") 44 | } 45 | 46 | #' @rdname get_attr 47 | #' @export 48 | is_cor_tbl <- function(x) { 49 | inherits(x, "cor_tbl") 50 | } 51 | 52 | #' @rdname get_attr 53 | #' @export 54 | is_general_cor_tbl <- function(x) { 55 | inherits(x, "general_cor_tbl") 56 | } 57 | 58 | 59 | 60 | 61 | -------------------------------------------------------------------------------- /R/cor-test.R: -------------------------------------------------------------------------------- 1 | #' Matrix of Correlations, P-values and confidence intervals 2 | #' @description \code{correlate} uses \code{cor} to find the correlations and use \code{cor.test} to find 3 | #' the p values, confidence intervals for all possible pairs of columns ofmatrix. 4 | #' @param x,y a matrix object or NULL. 5 | #' @param cor.test logical, if \code{TRUE} (default) will test for correlation. 6 | #' @param method a character string indicating which correlation coefficient is to be used 7 | #' for the test. One of "pearson", "kendall", or "spearman". 8 | #' @param use an optional character string giving a method for computing covariances in the presence of missing values. 9 | #' @param ... extra params, see Details. 10 | #' @details The columns of 'x' will be tested for each pair when y is NULL(the default), 11 | #' otherwise each column in 'x' and each column in 'y' is tested for each pair. 12 | #' @return a list with correlation matrix, P values matrix, confidence intervals matrix. 13 | #' @importFrom stats cor cor.test 14 | #' @importFrom purrr walk2 15 | #' @rdname corrlate 16 | #' @examples 17 | #' correlate(mtcars) 18 | #' m1 <- matrix(rnorm(100), nrow = 10) 19 | #' m2 <- matrix(rnorm(60), nrow = 10) 20 | #' 21 | #' ## not test for correlation matrix 22 | #' correlate(m1, m2) 23 | #' 24 | #' ## test for correlation matrix 25 | #' correlate(m1, m2, cor.test = TRUE) 26 | #' 27 | #' ## fast compute correlation 28 | #' \dontrun{ 29 | #' require(WGCNA) 30 | #' fast_correlate(m1, m2) 31 | #' 32 | #' require(picante) 33 | #' fast_correlate2(m1) 34 | #' } 35 | #' @seealso \code{\link[stats]{cor}}, \code{\link[stats]{cor.test}}. 36 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 37 | #' @export 38 | correlate <- function(x, 39 | y = NULL, 40 | cor.test = FALSE, 41 | method = "pearson", 42 | use = "everything", 43 | ...) 44 | { 45 | y <- y %||% x 46 | if(!is.matrix(x)) 47 | x <- as.matrix(x) 48 | if(!is.matrix(y)) 49 | y <- as.matrix(y) 50 | n <- ncol(x) 51 | m <- ncol(y) 52 | r <- cor(x, y, use = use, method = method) 53 | if(cor.test) { 54 | p.value <- lower.ci <- upper.ci <- matrix(NA, ncol = m, nrow = n) 55 | df <- expand.grid(1:n, 1:m) 56 | purrr::walk2(df$Var1, df$Var2, function(.idx, .idy) { 57 | tmp <- cor.test(x = x[ , .idx], y = y[ , .idy], method = method, ...) 58 | p.value[.idx, .idy] <<- tmp$p.value 59 | if(method == "pearson") { 60 | if (nrow(x) > 3) { 61 | lower.ci[.idx, .idy] <<- tmp$conf.int[1] 62 | upper.ci[.idx, .idy] <<- tmp$conf.int[2] 63 | } else { 64 | warning("correlation test interval needs 4 observations at least.", call. = FALSE) 65 | } 66 | } 67 | }) 68 | } 69 | if(cor.test) { 70 | lower.ci <- if(method == "pearson") lower.ci else NULL 71 | upper.ci <- if(method == "pearson") upper.ci else NULL 72 | } else { 73 | p.value <- lower.ci <- upper.ci <- NULL 74 | } 75 | structure( 76 | .Data = list( 77 | r = r, 78 | p.value = p.value, 79 | lower.ci = lower.ci, 80 | upper.ci = upper.ci 81 | ), class = "correlate" 82 | ) 83 | } 84 | 85 | #' @rdname corrlate 86 | #' @export 87 | fast_correlate <- function(x, 88 | y = NULL, 89 | use = "everything", 90 | ...) 91 | { 92 | if(!requireNamespace("WGCNA", quietly = TRUE)) { 93 | stop("'fast_correlate' needs 'WGCNA' package.", call. = FALSE) 94 | } 95 | corr <- WGCNA::corAndPvalue(x, y, use, ...) 96 | structure(.Data = list(r = corr$cor, p.value = corr$p), 97 | class = "correlate") 98 | } 99 | 100 | #' @rdname corrlate 101 | #' @export 102 | fast_correlate2 <- function (x, 103 | method = "pearson", 104 | ...) 105 | { 106 | if(!requireNamespace("picante", quietly = TRUE)) { 107 | stop("'fast_correlate2' needs 'picante' package.", call. = FALSE) 108 | } 109 | corr <- picante::cor.table(x, method, ...) 110 | structure(.Data = list(r = corr$r, p.value = corr$P), 111 | class = "correlate") 112 | } 113 | 114 | #' Print for correlate object. 115 | #' @param x an object used to select a method. 116 | #' @param all if FALSE (default) just print correlation matrix, else will 117 | #' print all values. 118 | #' @param ... extra params passing to \code{print}. 119 | #' @examples 120 | #' m <- correlate(mtcars, cor.test = TRUE) 121 | #' print(m) 122 | #' print(m, TRUE) 123 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 124 | #' @export 125 | print.correlate <- function(x, all = FALSE, ...) { 126 | if(all) print(x, ...) else print(x$r, ...) 127 | } 128 | -------------------------------------------------------------------------------- /R/dplyr.R: -------------------------------------------------------------------------------- 1 | #' @importFrom tibble as_tibble 2 | #' @export 3 | as_tibble.cor_tbl <- function(x, ...) 4 | { 5 | class(x) <- setdiff(class(x), "cor_tbl") 6 | attrs <- attributes(x) 7 | excludes <- attrs[setdiff(names(attrs), c("names", "class", "row.names"))] 8 | if(length(excludes) > 0) { 9 | for (nm in names(excludes)) { 10 | attr(x, nm) <- NULL 11 | } 12 | } 13 | x 14 | } 15 | 16 | #' @importFrom dplyr filter 17 | filter.cor_tbl <- function(.data, ...) 18 | { 19 | attrs <- attributes(.data) 20 | .data <- filter(as_tibble(.data), ...) 21 | set_attrs(.data, attrs, .excludes = c("names", "row.names")) 22 | } 23 | 24 | #' @importFrom dplyr mutate 25 | #' @export 26 | mutate.cor_tbl <- function(.data, ...) 27 | { 28 | attrs <- attributes(.data) 29 | .data <- dplyr::mutate(as_tibble(.data), ...) 30 | set_attrs(.data, attrs, .excludes = c("names", "row.names")) 31 | } 32 | 33 | #' @importFrom dplyr group_by 34 | #' @export 35 | group_by.cor_tbl <- function(.data, add = FALSE, ...) 36 | { 37 | attrs <- attributes(.data) 38 | .data <- group_by(as_tibble(.data), add = FALSE) 39 | structure(.Data = .data, 40 | class = c("grouped_cor_tbl", class(.data)), 41 | attrs = attrs) 42 | } 43 | 44 | #' @importFrom dplyr ungroup 45 | #' @export 46 | ungroup.grouped_cor_tbl <- function(x, ...) 47 | { 48 | attrs <- attr(x, "attrs") 49 | class(x) <- setdiff(class(x), "grouped_cor_tbl") 50 | x <- ungroup(x, ...) 51 | class(.data) <- c("grouped_cor_tbl", class(.data)) 52 | set_attrs(.data, attrs, .excludes = c("names", "row.names")) 53 | } 54 | #' @noRd 55 | set_attrs <- function(.data, .attrs = list(), .excludes = NULL) 56 | { 57 | .excludes <- .excludes %||% c("names", "class", "row.names") 58 | new.attrs <- .attrs[setdiff(names(.attrs), .excludes)] 59 | if(length(new.attrs) > 0) { 60 | for (nm in names(new.attrs)) { 61 | attr(.data, nm) <- new.attrs[[nm]] 62 | } 63 | } 64 | .data 65 | } 66 | #' @noRd 67 | remove_attrs <- function(.data, .excludes = NULL) 68 | { 69 | attrs <- attributes(.data) 70 | .excludes <- .excludes %||% c("names", "class", "row.names") 71 | rm.attr.name <- setdiff(names(attrs), .excludes) 72 | if(length(rm.attr.name) > 0) { 73 | for (nm in rm.attr.name) { 74 | attr(.data, nm) <- NULL 75 | } 76 | } 77 | .data 78 | } 79 | 80 | ## extended dplyr for network 81 | #' @importFrom dplyr filter 82 | #' @export 83 | filter.cor_network <- function(.data, 84 | ..., 85 | what = "nodes", 86 | simplify = TRUE) 87 | { 88 | nodes <- .data$nodes 89 | edges <- .data$edges 90 | if(what == "nodes") { 91 | nodes <- filter(nodes, ...) 92 | e.id <- edges$from %in% nodes$name & 93 | edges$to %in% nodes$name 94 | edges <- filter(edges, e.id) 95 | } else { 96 | edges <- filter(edges, ...) 97 | if(simplify) { 98 | n.id <- nodes$name %in% c(edges$from, edges$to) 99 | nodes <- filter(nodes, n.id) 100 | } 101 | } 102 | structure(.Data = list(nodes = nodes, 103 | edges = edges), class = "cor_network") 104 | } 105 | 106 | #' @importFrom dplyr filter 107 | #' @importFrom igraph as.igraph 108 | #' @export 109 | filter.igraph <- function(.data, 110 | ..., 111 | what = "nodes", 112 | simplify = TRUE) 113 | { 114 | .data <- filter(as_cor_network(.data, ..., what = what, simplify = simplify)) 115 | as.igraph(.data) 116 | } 117 | 118 | #' @importFrom dplyr mutate 119 | #' @export 120 | mutate.cor_network <- function(.data, what = "nodes", ...) 121 | { 122 | check_mutate_var_name(what, ...) 123 | if(what == "nodes") { 124 | .data$nodes <- dplyr::mutate(.data$nodes, ...) 125 | } else { 126 | .data$edges <- dplyr::mutate(.data$edges, ...) 127 | } 128 | .data 129 | } 130 | 131 | #' @importFrom dplyr mutate 132 | #' @importFrom igraph as.igraph 133 | #' @export 134 | mutate.igraph <- function(.data, ..., what = "nodes") 135 | { 136 | .data <- mutate(as_cor_network(.data), what = what, ...) 137 | as.igraph(.data) 138 | } 139 | 140 | #' @noRd 141 | check_mutate_var_name <- function(what = "nodes", ...) { 142 | var.name <- list(...) 143 | if(what == "nodes") { 144 | if("name" %in% var.name) { 145 | stop("variable of 'name' is preserved.", call. = FALSE) 146 | } 147 | } else { 148 | if(any(c("from", "to") %in% var.name)) { 149 | stop("variable of 'from' and 'to' are preserved.", call. = FALSE) 150 | } 151 | } 152 | } 153 | -------------------------------------------------------------------------------- /R/expand-axis.R: -------------------------------------------------------------------------------- 1 | #' Expand axis limits 2 | #' @description Force to extend the coordinate range of the ggplot object. 3 | #' @param x,y NULL (default) or numeric vector. 4 | #' @rdname expand_axis 5 | #' @examples 6 | #' quickcor(mtcars) + geom_square() + expand_axis(x = -3) 7 | #' quickcor(mtcars) + geom_square() + expand_axis(y = 16) 8 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 9 | #' @export 10 | expand_axis <- function(x = NULL, y = NULL) 11 | { 12 | reset_axis_lim <- function(p) { 13 | if(!is.null(x) && !is.numeric(x)) x <- NULL 14 | if(!is.null(y) && !is.numeric(y)) y <- NULL 15 | if(is.null(x) && is.null(y)) 16 | return(p) 17 | x.scale <- p$scales$get_scales("x") 18 | y.scale <- p$scales$get_scales("y") 19 | scale.x.limits <- if(!is.null(x.scale)) { 20 | x.scale$get_limits() 21 | } else NULL 22 | scale.y.limits <- if(!is.null(y.scale)) { 23 | y.scale$get_limits() 24 | } else NULL 25 | xlim <- p$coordinates$limits$x %||% scale.x.limits 26 | ylim <- p$coordinates$limits$y %||% scale.y.limits 27 | if(!is.null(x) && !is.null(xlim)) { 28 | p$coordinates$limits$x <- c(min(xlim, x, na.rm = TRUE), 29 | max(xlim, x, na.rm = TRUE)) 30 | } 31 | if(!is.null(y) && !is.null(ylim)) { 32 | p$coordinates$limits$y <- c(min(ylim, y, na.rm = TRUE), 33 | max(ylim, y, na.rm = TRUE)) 34 | } 35 | p 36 | } 37 | class(reset_axis_lim) <- c("expand_axis", class(reset_axis_lim)) 38 | reset_axis_lim 39 | } 40 | 41 | #' @importFrom ggplot2 ggplot_add 42 | #' @export 43 | #' @method ggplot_add expand_axis 44 | ggplot_add.expand_axis <- function(object, plot, object_name) { 45 | plot <- object(plot) 46 | plot 47 | } 48 | -------------------------------------------------------------------------------- /R/fortify-cor.R: -------------------------------------------------------------------------------- 1 | #' Convert to cor_tbl based on input type.convert 2 | #' @description The fortify_cor function is a deep encapsulation of 3 | #' the \code{as_cor_tbl} function and also supports converting raw 4 | #' data into cor_tbl objects by calculation. 5 | #' @param x any \code{R} object. 6 | #' @param y NULL (default) or a matrix or data frame with compatible 7 | #' dimensions to x. 8 | #' @param is.cor logical value (default to FALSE) indicating wheater 9 | #' \code{x} is a correlation matrix. 10 | #' @param group NULL (default) or a vector that has the same number 11 | #' of rows as x. 12 | #' @param type a string, "full" (default), "upper" or "lower", display full, 13 | #' lower triangular or upper triangular matrix. 14 | #' @param show.diag a logical value indicating whether keep the diagonal. 15 | #' @param cor.test logical value (default is FALSE) indicating whether test 16 | #' for the correlation. 17 | #' @param cluster logical value (default is FALSE) indicating whether reorder 18 | #' the correlation matrix by cluster. 19 | #' @param cluster.method the agglomeration method to be used. This should be 20 | #' (an unambiguous abbreviation of) one of "ward.D", "ward.D2", "single", 21 | #' "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) 22 | #' or "centroid" (= UPGMC). 23 | #' @param k integer, the number of cluster group. 24 | #' @param ... extra params passing to \code{matrix_order}. 25 | #' @return cor_tbl object. 26 | #' @importFrom dplyr %>% mutate 27 | #' @rdname fortify_cor 28 | #' @examples 29 | #' fortify_cor(mtcars) 30 | #' fortify_cor(iris[-5], group = iris[[5]]) 31 | #' fortify_cor(mtcars, type = "lower", cluster = TRUE) 32 | #' m <- cor(mtcars) 33 | #' fortify_cor(m, is.cor = TRUE) 34 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 35 | #' @seealso \code{\link[ggcor]{matrix_order}}, \code{\link[stats]{hclust}}, 36 | #' \code{\link[ggcor]{as_cor_tbl}}. 37 | #' @export 38 | fortify_cor <- function(x, 39 | y = NULL, 40 | is.cor = FALSE, 41 | group = NULL, 42 | type = "full", 43 | show.diag = FALSE, 44 | cor.test = FALSE, 45 | cluster = FALSE, 46 | cluster.method = "complete", 47 | k = 2, 48 | ...) 49 | { 50 | type <- match.arg(type, c("full", "upper", "lower")) 51 | if(is_cor_tbl(x)) { 52 | return( 53 | switch (type, 54 | full = x, 55 | upper = get_upper_data(x, show.diag), 56 | lower = get_lower_data(x, show.diag) 57 | )) 58 | } 59 | clss <- c("correlate", "rcorr", "corr.test", "mantel_tbl") 60 | if(any(clss %in% class(x)) || is.cor) { 61 | return(as_cor_tbl(x, type = type, show.diag = show.diag, cluster = cluster, 62 | cluster.method = cluster.method, ...)) 63 | } 64 | y <- y %||% x 65 | if(!is.data.frame(x)) 66 | x <- as.data.frame(x) 67 | if(!is.data.frame(y)) { 68 | y <- as.data.frame(y) 69 | if(nrow(x) != nrow(y)) 70 | stop("'y' must have the same rows as 'x'.", call. = FALSE) 71 | } 72 | if(!is.null(group)) { 73 | if(length(group) != nrow(x)) 74 | stop("'group' must have the same length as rows of 'x'.", call. = FALSE) 75 | x <- split(x, group, drop = FALSE) 76 | y <- split(y, group, drop = FALSE) 77 | dfs <- purrr::pmap(list(x, y, as.list(names(x))), 78 | function(.x, .y, .group) { 79 | correlate(.x, .y, cor.test, ...) %>% 80 | as_cor_tbl(type = type, show.diag = show.diag, cluster = cluster, 81 | cluster.method = cluster.method, k = k) %>% 82 | mutate(.group = .group) 83 | }) 84 | attrs <- attributes(dfs[[1]]) 85 | df <- suppressMessages( 86 | set_attrs(dplyr::bind_rows(dfs), attrs) 87 | ) 88 | } else { 89 | corr <- correlate(x, y, cor.test, ...) 90 | df <- as_cor_tbl(corr, type = type, show.diag = show.diag, cluster = cluster, 91 | cluster.method = cluster.method, k = k) 92 | } 93 | attr(df, "grouped") <- if(is.null(group)) FALSE else TRUE 94 | df 95 | } 96 | -------------------------------------------------------------------------------- /R/geom-conf.R: -------------------------------------------------------------------------------- 1 | #' Confident-Box Geom 2 | #' 3 | #' @param width the width of confident box. 4 | #' @inheritParams ggplot2::layer 5 | #' @inheritParams ggplot2::geom_polygon 6 | #' @section Aesthetics: 7 | #' \code{geom_confbox()} understands the following aesthetics (required 8 | #' aesthetics are in bold): 9 | #' \itemize{ 10 | #' \item \strong{\code{x}} 11 | #' \item \strong{\code{y}} 12 | #' \item \strong{\code{r}} 13 | #' \item \strong{\code{lower.ci}} 14 | #' \item \strong{\code{upper.ci}} 15 | #' \item \code{alpha} 16 | #' \item \code{colour} 17 | #' \item \code{confline.col} 18 | #' \item \code{midline.col} 19 | #' \item \code{fill} 20 | #' \item \code{linetype} 21 | #' \item \code{size} 22 | #' } 23 | #' @importFrom ggplot2 layer ggproto Geom GeomPolygon GeomSegment aes draw_key_polygon 24 | #' @importFrom grid grobTree 25 | #' @rdname geom_confbox 26 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 27 | #' @export 28 | geom_confbox <- function(mapping = NULL, data = NULL, 29 | stat = "identity", position = "identity", 30 | ..., 31 | width = 0.5, 32 | na.rm = FALSE, 33 | show.legend = NA, 34 | inherit.aes = TRUE) { 35 | layer( 36 | data = data, 37 | mapping = mapping, 38 | stat = stat, 39 | geom = GeomConfbox, 40 | position = position, 41 | show.legend = show.legend, 42 | inherit.aes = inherit.aes, 43 | params = list( 44 | width = width, 45 | na.rm = na.rm, 46 | ... 47 | ) 48 | ) 49 | } 50 | 51 | #' @rdname geom_confbox 52 | #' @format NULL 53 | #' @usage NULL 54 | #' @export 55 | GeomConfbox <- ggproto( 56 | "GeomConfbox", Geom, 57 | default_aes = aes(confline.col = "grey30", midline.col = "grey50", 58 | colour = NA, fill = "grey60", size = 0.5, 59 | midline.type = "dotted", linetype = 1, 60 | alpha = NA), 61 | required_aes = c("x", "y", "r", "lower.ci", "upper.ci"), 62 | draw_panel = function(self, data, panel_params, coord, width = 0.5) { 63 | aesthetics <- setdiff( 64 | names(data), c("x", "y", "r", "lower.ci", "upper.ci") 65 | ) 66 | grobs <- lapply(split(data, seq_len(nrow(data))), function(row) { 67 | d <- point_to_confbox(row$x, row$y, row$r, row$lower.ci, row$upper.ci, width) 68 | confbox <- d$conf_box 69 | confline <- d$conf_line 70 | midline <- d$mid_line 71 | ## draw mid line 72 | mid_aes <- cbind(midline, new_data_frame(row[aesthetics])) 73 | mid_aes$colour <- row$midline.col 74 | mid_aes$linetype <- row$midline.type 75 | mid <- GeomSegment$draw_panel(mid_aes, panel_params, coord) 76 | ## draw conf box 77 | confbox_aes <- cbind(confbox, 78 | new_data_frame(row[aesthetics])[rep(1, 5), ]) 79 | confbox_aes$colour <- NA 80 | box <- GeomPolygon$draw_panel(confbox_aes, panel_params, coord) 81 | ## draw conf line 82 | confline_aes <- cbind(confline, 83 | new_data_frame(row[aesthetics])[rep(1, 3), ]) 84 | confline_aes$colour <- row$confline.col 85 | line <- GeomSegment$draw_panel(confline_aes, panel_params, coord) 86 | grid::gList(mid, box, line) 87 | }) 88 | ggplot2:::ggname("geom_confbox", do.call("grobTree", grobs)) 89 | }, 90 | draw_key = draw_key_polygon 91 | ) 92 | 93 | #' @noRd 94 | point_to_confbox <- function(x, y, r, lower.ci, upper.ci, width = 0.5) { 95 | r <- r / 2 96 | lower.ci <- lower.ci / 2 97 | upper.ci <- upper.ci / 2 98 | ## confidence box 99 | xmin <- - 0.5 * width + x 100 | xmax <- 0.5 * width + x 101 | ymin <- lower.ci + y 102 | ymax <- upper.ci + y 103 | conf_box <- new_data_frame(list( 104 | y = c(ymax, ymax, ymin, ymin, ymax), 105 | x = c(xmin, xmax, xmax, xmin, xmin) 106 | )) 107 | ## confidence line 108 | xx <- rep_len(xmin, 3) 109 | xend <- rep_len(xmax, 3) 110 | yy <- c(lower.ci, r, upper.ci) + y 111 | yend <- c(lower.ci, r, upper.ci) + y 112 | 113 | conf_line <- new_data_frame(list( 114 | x = xx, 115 | y = yy, 116 | xend = xend, 117 | yend = yend 118 | )) 119 | ## mid line 120 | mid_line <- new_data_frame(list( 121 | x = x - 0.5, 122 | y = y, 123 | xend = x + 0.5, 124 | yend = y 125 | )) 126 | ## return confbox, confline, midline list 127 | list(conf_box = conf_box, 128 | conf_line = conf_line, 129 | mid_line = mid_line) 130 | } 131 | 132 | -------------------------------------------------------------------------------- /R/geom-cross.R: -------------------------------------------------------------------------------- 1 | #' Cross Geom 2 | #' 3 | #' @param sig.level significance threshold. 4 | #' @inheritParams ggplot2::layer 5 | #' @inheritParams ggplot2::geom_segment 6 | #' @section Aesthetics: 7 | #' \code{geom_cross()} understands the following aesthetics (required 8 | #' aesthetics are in bold): 9 | #' \itemize{ 10 | #' \item \strong{\code{x}} 11 | #' \item \strong{\code{y}} 12 | #' \item \strong{\code{p.value}} 13 | #' \item \code{alpha} 14 | #' \item \code{colour} 15 | #' \item \code{linetype} 16 | #' \item \code{size} 17 | #' } 18 | #' @importFrom ggplot2 layer ggproto GeomSegment aes draw_key_blank 19 | #' @importFrom grid grobTree 20 | #' @rdname geom_cross 21 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 22 | #' @export 23 | geom_cross <- function(mapping = NULL, data = NULL, 24 | stat = "identity", position = "identity", 25 | ..., 26 | sig.level = 0.05, 27 | linejoin = "mitre", 28 | na.rm = FALSE, 29 | show.legend = NA, 30 | inherit.aes = TRUE) { 31 | layer( 32 | data = data, 33 | mapping = mapping, 34 | stat = stat, 35 | geom = GeomCross, 36 | position = position, 37 | show.legend = show.legend, 38 | inherit.aes = inherit.aes, 39 | params = list( 40 | sig.level = sig.level, 41 | linejoin = linejoin, 42 | na.rm = na.rm, 43 | ... 44 | ) 45 | ) 46 | } 47 | 48 | #' @rdname geom_cross 49 | #' @format NULL 50 | #' @usage NULL 51 | #' @export 52 | GeomCross <- ggproto( 53 | "GeomCross", GeomSegment, 54 | default_aes = aes(colour = "red", size = 0.5, linetype = 1, alpha = NA), 55 | required_aes = c("x", "y", "p.value"), 56 | 57 | draw_panel = function(self, data, panel_params, coord, linejoin = "mitre", 58 | sig.level = 0.05, r0 = 0.6) { 59 | if (!coord$is_linear()) { 60 | warning("geom_cross is not implemented for non-linear coordinates", 61 | call. = FALSE) 62 | } 63 | aesthetics <- setdiff(names(data), c("x", "y", "p.value")) 64 | data <- with(data, subset(data, p.value > sig.level)) 65 | dd <- point_to_cross(data$x, data$y, r0) 66 | aes <- data[rep(1:nrow(data), each = 2) , aesthetics, drop = FALSE] 67 | GeomSegment$draw_panel(cbind(dd, aes), panel_params, coord) 68 | }, 69 | draw_key = draw_key_blank 70 | ) 71 | 72 | #' @noRd 73 | point_to_cross <- function(x, y, r = 0.6) { 74 | xx <- c(x - 0.5 * r, x - 0.5 * r) 75 | xend <- c(x + 0.5 * r, x + 0.5 * r) 76 | yy <- c(y - 0.5 * r, y + 0.5 * r) 77 | yend <- c(y + 0.5 * r, y - 0.5 * r) 78 | 79 | new_data_frame(list( 80 | x = xx, 81 | y = yy, 82 | xend = xend, 83 | yend = yend 84 | )) 85 | } 86 | -------------------------------------------------------------------------------- /R/geom-diag-label.R: -------------------------------------------------------------------------------- 1 | #' Add diagnoal labels on correlation plot 2 | #' @description \code{geom_diag_label} is mainly used with \code{ggcor} and 3 | #' \code{quickcor} functions to add diagnoal labels on correct position 4 | #' base on different type of cor_tbl object. 5 | #' @param mapping aesthetic mappings parameters. 6 | #' @param data NULL (default) or a cor_tbl object. 7 | #' @param drop logical value (default is TRUE). When type of plot is 'upper' 8 | #' or 'lower' and 'show.diag' is FALSE, whether need to remove the blank label. 9 | #' @param ... extra params for \code{\link[ggplot2]{geom_text}}. 10 | #' @importFrom ggplot2 geom_text aes_string 11 | #' @rdname geom_diag_label 12 | #' @examples 13 | #' quickcor(mtcars, type = "upper") + geom_colour() + geom_diag_label() 14 | #' quickcor(mtcars, type = "lower") + geom_colour() + geom_diag_label() 15 | #' @seealso \code{\link[ggplot2]{geom_text}}. 16 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 17 | #' @export 18 | geom_diag_label <- function(mapping = NULL, data = NULL, drop = FALSE, ...) 19 | { 20 | if(!is.null(data)) { 21 | if(!is_cor_tbl(data)) { 22 | stop("Need a cor_tbl object.", call. = FALSE) 23 | } 24 | data <- get_diag_label_data(drop)(data) 25 | } 26 | mapping <- aes_modify(aes_string("x", "y", label = "label"), mapping) 27 | geom_text(mapping = mapping, 28 | data = data %||% get_diag_label_data(drop = drop), 29 | inherit.aes = FALSE, ...) 30 | } 31 | 32 | #' @rdname geom_diag_label 33 | #' @format NULL 34 | #' @usage NULL 35 | #' @export 36 | add_diag_label <- function(...) { 37 | warning("`add_diag_label()` is deprecated. ", 38 | "Use `geom_diag_label()` instead.", call. = FALSE) 39 | geom_diag_label(...) 40 | } 41 | #' @noRd 42 | get_diag_label_data <- function(drop = FALSE) { 43 | function(data) { 44 | empty <- new_data_frame(list(x = numeric(0), 45 | y = numeric(0), 46 | label = character(0))) 47 | if(!is_cor_tbl(data)) { 48 | warning("Need a cor_tbl.", call. = FALSE) 49 | return(empty) 50 | } 51 | if(!is_symmet(data)) { 52 | warning("'add_diag_label' just supports for symmetrical correlation matrxi.", call. = FALSE) 53 | return(empty) 54 | } 55 | type <- get_type(data) 56 | show.diag <- get_show_diag(data) 57 | row.names <- rev(get_row_name(data)) 58 | n <- length(row.names) 59 | y <- 1:n 60 | lab <- row.names 61 | if(type == "upper") { 62 | if(show.diag) { 63 | x <- n - y 64 | } else { 65 | x <- n - y + 1 66 | if(drop) { 67 | x <- x[2:n] 68 | y <- y[2:n] 69 | lab <- lab[2:n] 70 | } 71 | } 72 | } else if(type == "lower") { 73 | if(show.diag) { 74 | x <- n - y + 2 75 | } else { 76 | x <- n - y + 1 77 | if(drop) { 78 | x <- x[1:(n - 1)] 79 | y <- y[1:(n - 1)] 80 | lab <- lab[1:(n - 1)] 81 | } 82 | } 83 | } else { 84 | x <- n - y + 1 85 | } 86 | new_data_frame(list(x = x, y = y, label = lab)) 87 | } 88 | } 89 | -------------------------------------------------------------------------------- /R/geom-hc-rect.R: -------------------------------------------------------------------------------- 1 | #' Draw square mark on correlation matrix plot 2 | #' 3 | #' @description Draw the cluster square mark on the correlation matrix plot. 4 | #' @param data a correlation matrix or hc_rect_df object. 5 | #' @param fill NA (default) or the fill colour of square. 6 | #' @param colour,color the colour of square boder. 7 | #' @param size size of square boder line. 8 | #' @importFrom ggplot2 geom_rect geom_blank aes_string 9 | #' @rdname geom_hc_rect 10 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 11 | #' @export 12 | geom_hc_rect <- function(data = NULL, 13 | fill = NA, 14 | colour = "black", 15 | size = 2, 16 | color = NULL) 17 | { 18 | if(!is.null(data) && !inherits(data, "hc_rect_df")) { 19 | stop("Invalid data input.", call. = FALSE) 20 | } 21 | if(!is.null(color)) 22 | colour <- color 23 | geom_rect(mapping = aes_string(xmin = "xmin", ymin = "ymin", 24 | xmax = "xmax", ymax = "ymax"), 25 | data = if(is.null(data)) get_hc_rect_df() else data, 26 | colour = colour, size = size, fill = fill, inherit.aes = FALSE) 27 | } 28 | 29 | #' @rdname geom_hc_rect 30 | #' @export 31 | get_hc_rect_df <- function() { 32 | function(data) { 33 | stopifnot(is_cor_tbl(data)) 34 | attr(data, "hc.rect.df") 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /R/geom-link.R: -------------------------------------------------------------------------------- 1 | #' Special layer function for correlation link plot 2 | #' @description A set of custom layer functions that quickly add 3 | #' layers of curves, nodes, and labels. 4 | #' @param mapping aesthetic mappings parameters. 5 | #' @param data NULL or a layout_link_tbl object that create by 6 | #' \code{parallel_layout()} or \code{combination_layout()}. 7 | #' @param curvature a numeric value giving the amount of curvature. 8 | #' @param inherit.aes If FALSE, overrides the default aesthetics, rather than 9 | #' combining with them. 10 | #' @param ... extra parameters passing to layer function. 11 | #' @return geom layer. 12 | #' @importFrom ggplot2 aes_string geom_curve geom_point geom_text 13 | #' @importFrom dplyr filter 14 | #' @rdname geom_link 15 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 16 | #' @export 17 | geom_link <- function(mapping = NULL, 18 | data = NULL, 19 | curvature = 0, 20 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 21 | ...) 22 | { 23 | mapping <- aes_modify( 24 | aes_string(x = "x", y = "y", xend = "xend", yend = "yend"), mapping 25 | ) 26 | geom_curve(mapping = mapping, data = data, curvature = curvature, 27 | inherit.aes = inherit.aes, ...) 28 | } 29 | 30 | #' @rdname geom_link 31 | #' @export 32 | geom_link_point <- function(...) 33 | { 34 | list( 35 | geom_start_point(...), 36 | geom_end_point(...) 37 | ) 38 | } 39 | 40 | #' @rdname geom_link 41 | #' @export 42 | geom_link_label <- function(...) 43 | { 44 | list( 45 | geom_start_label(...), 46 | geom_end_label(...) 47 | ) 48 | } 49 | 50 | #' @rdname geom_link 51 | #' @export 52 | geom_start_point <- function(mapping = NULL, 53 | data = NULL, 54 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 55 | ...) 56 | { 57 | if(!is.null(data) && !inherits(data, "layout_link_tbl")) { 58 | stop("Need a layout_link_tbl.", call. = FALSE) 59 | } 60 | data <- if(is.null(data)) { 61 | get_start_nodes() 62 | } else { 63 | get_start_nodes()(data) 64 | } 65 | mapping <- aes_modify( 66 | aes_string(x = "x", y = "y"), mapping 67 | ) 68 | geom_point(mapping = mapping, data = data, inherit.aes = inherit.aes, ...) 69 | } 70 | 71 | #' @rdname geom_link 72 | #' @export 73 | geom_end_point <- function(mapping = NULL, 74 | data = NULL, 75 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 76 | ...) 77 | { 78 | if(!is.null(data) && !inherits(data, "layout_link_tbl")) { 79 | stop("Need a layout_link_tbl.", call. = FALSE) 80 | } 81 | data <- if(is.null(data)) { 82 | get_end_nodes() 83 | } else { 84 | get_end_nodes()(data) 85 | } 86 | mapping <- aes_modify( 87 | aes_string(x = "xend", y = "yend"), mapping 88 | ) 89 | geom_point(mapping = mapping, data = data, inherit.aes = inherit.aes, ...) 90 | } 91 | 92 | #' @rdname geom_link 93 | #' @export 94 | geom_start_label <- function(mapping = NULL, 95 | data = NULL, 96 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 97 | ...) 98 | { 99 | if(!is.null(data) && !inherits(data, "layout_link_tbl")) { 100 | stop("Need a layout_link_tbl.", call. = FALSE) 101 | } 102 | data <- if(is.null(data)) { 103 | get_start_nodes() 104 | } else { 105 | get_start_nodes()(data) 106 | } 107 | mapping <- aes_modify( 108 | aes_string(x = "x", y = "y", label = "start.label"), mapping 109 | ) 110 | geom_text(mapping = mapping, data = data, inherit.aes = inherit.aes, ...) 111 | } 112 | 113 | #' @rdname geom_link 114 | #' @export 115 | geom_end_label <- function(mapping = NULL, 116 | data = NULL, 117 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 118 | ...) 119 | { 120 | if(!is.null(data) && !inherits(data, "layout_link_tbl")) { 121 | stop("Need a layout_link_tbl.", call. = FALSE) 122 | } 123 | data <- if(is.null(data)) { 124 | get_end_nodes() 125 | } else { 126 | get_end_nodes()(data) 127 | } 128 | mapping <- aes_modify( 129 | aes_string(x = "xend", y = "yend", label = "end.label"), mapping 130 | ) 131 | geom_text(mapping = mapping, data = data, inherit.aes = inherit.aes, ...) 132 | } 133 | 134 | #' @rdname geom_link 135 | #' @export 136 | get_start_nodes <- function() { 137 | function(data) { 138 | stopifnot(inherits(data, "layout_link_tbl")) 139 | dplyr::filter(data, .start.filter) 140 | } 141 | } 142 | 143 | #' @rdname geom_link 144 | #' @export 145 | get_end_nodes <- function() { 146 | function(data) { 147 | stopifnot(inherits(data, "layout_link_tbl")) 148 | dplyr::filter(data, .end.filter) 149 | } 150 | } 151 | 152 | #' @importFrom utils modifyList 153 | #' @noRd 154 | aes_modify <- function(aes1, aes2) { 155 | aes <- modifyList(as.list(aes1), as.list(aes2)) 156 | class(aes) <- "uneval" 157 | aes 158 | } 159 | 160 | -------------------------------------------------------------------------------- /R/geom-link2.R: -------------------------------------------------------------------------------- 1 | #' Link Geom 2 | #' 3 | #' @inheritParams ggplot2::layer 4 | #' @inheritParams ggplot2::geom_curve 5 | #' @section Aesthetics: 6 | #' \code{geom_link()} understands the following aesthetics (required aesthetics are in bold): 7 | #' \itemize{ 8 | #' \item \strong{\code{x}} 9 | #' \item \strong{\code{y}} 10 | #' \item \strong{\code{xend}} 11 | #' \item \strong{\code{yend}} 12 | #' \item \code{alpha} 13 | #' \item \code{colour} 14 | #' \item \code{fill} 15 | #' \item \code{group} 16 | #' \item \code{linetype} 17 | #' \item \code{size} 18 | #' } 19 | #' @importFrom ggplot2 layer ggproto GeomCurve GeomPoint draw_key_path 20 | #' @importFrom grid gTree 21 | #' @rdname geom_link2 22 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 23 | #' @export 24 | geom_link2 <- function(mapping = NULL, 25 | data = NULL, 26 | stat = "identity", 27 | position = "identity", 28 | ..., 29 | curvature = 0, 30 | angle = 90, 31 | ncp = 5, 32 | arrow = NULL, 33 | arrow.fill = NULL, 34 | lineend = "butt", 35 | na.rm = FALSE, 36 | show.legend = NA, 37 | inherit.aes = TRUE) { 38 | layer( 39 | data = data, 40 | mapping = mapping, 41 | stat = stat, 42 | geom = GeomLink2, 43 | position = position, 44 | show.legend = show.legend, 45 | inherit.aes = inherit.aes, 46 | params = list( 47 | curvature = curvature, 48 | angle = angle, 49 | ncp = ncp, 50 | arrow = arrow, 51 | arrow.fill = arrow.fill, 52 | lineend = lineend, 53 | na.rm = na.rm, 54 | ... 55 | ) 56 | ) 57 | } 58 | 59 | #' @rdname geom_link2 60 | #' @format NULL 61 | #' @usage NULL 62 | #' @export 63 | GeomLink2 <- ggproto( 64 | "GeomLink2", GeomCurve, 65 | draw_panel = function(self, data, panel_params, coord, start.point.shape = 21, 66 | end.point.shape = 21, start.point.colour = NULL, 67 | end.point.colour = NULL, start.point.fill = NULL, 68 | end.point.fill = NULL, start.point.size = 2, 69 | end.point.size = 2, curvature = 0, angle = 90, 70 | ncp = 5, arrow = NULL, arrow.fill = NULL, lineend = "butt", 71 | na.rm = FALSE) { 72 | aesthetics <- setdiff(names(data), c("x", "y", "xend", "yend", "colour", 73 | "fill", "size", "linetype")) 74 | start.colour <- start.point.colour %||% data$colour 75 | end.colour <- end.point.colour %||% data$colour 76 | start.data <- new_data_frame( 77 | list(x = data$x, 78 | y = data$y, 79 | colour = start.colour, 80 | fill = start.point.fill %||% start.colour, 81 | shape = start.point.shape, 82 | size = start.point.size %||% data$size * 4, 83 | stroke = 0.5)) 84 | end.data <- new_data_frame( 85 | list(x = data$xend, 86 | y = data$yend, 87 | colour = end.colour, 88 | fill = end.point.fill %||% end.colour, 89 | shape = end.point.shape, 90 | size = end.point.size %||% data$size * 4, 91 | stroke = 0.5)) 92 | ggname( 93 | "geom_link", 94 | grid::gTree( 95 | children = grid::gList( 96 | GeomCurve$draw_panel(data, panel_params, coord, curvature = curvature, 97 | angle = angle, ncp = ncp, arrow = arrow, 98 | arrow.fill = arrow.fill, lineend = lineend, 99 | na.rm = na.rm), 100 | GeomPoint$draw_panel(cbind(start.data, data[aesthetics]), panel_params, coord), 101 | GeomPoint$draw_panel(cbind(end.data, data[aesthetics]), panel_params, coord) 102 | ) 103 | ) 104 | ) 105 | }, 106 | draw_key = draw_key_path 107 | ) 108 | -------------------------------------------------------------------------------- /R/geom-mark.R: -------------------------------------------------------------------------------- 1 | #' Significant marks Geom 2 | #' 3 | #' @param digits integer indicating the number of decimal places (round) or 4 | #' significant digits (signif) to be used, the default value is 2. 5 | #' @param nsmall the minimum number of digits to the right of the decimal 6 | #' point in formatting real/complex numbers in non-scientific formats, 7 | #' the default value is 2. 8 | #' @param sig.level significance level，the default values is [0.05, 0.01, 0.001]. 9 | #' @param mark significance mark，the default values is ["*", "**", "***"]. 10 | #' @param sig.thres if not NULL, just when p.value is not larger than sig.thres will be ploted. 11 | #' @param sep a character string to separate the number and mark symbols. 12 | #' @inheritParams ggplot2::layer 13 | #' @inheritParams ggplot2::geom_text 14 | #' @section Aesthetics: 15 | #' \code{geom_mark()} understands the following aesthetics (required 16 | #' aesthetics are in bold): 17 | #' \itemize{ 18 | #' \item \strong{\code{x}} 19 | #' \item \strong{\code{y}} 20 | #' \item \strong{\code{p.value}} 21 | #' \item \code{r} 22 | #' \item \code{alpha} 23 | #' \item \code{colour} 24 | #' \item \code{size} 25 | #' \item \code{angle} 26 | #' \item \code{hjust} 27 | #' \item \code{vjust} 28 | #' \item \code{family} 29 | #' \item \code{fontface} 30 | #' \item \code{lineheight} 31 | #' } 32 | #' @importFrom ggplot2 layer ggproto GeomText aes draw_key_text 33 | #' @rdname geom_mark 34 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 35 | #' @export 36 | geom_mark <- function(mapping = NULL, data = NULL, 37 | stat = "identity", position = "identity", 38 | ..., 39 | nudge_x = 0, 40 | nudge_y = 0, 41 | digits = 2, 42 | nsmall = 2, 43 | sig.level = c(0.05, 0.01, 0.001), 44 | mark = c("*", "**", "***"), 45 | sig.thres = NULL, 46 | sep = "", 47 | parse = FALSE, 48 | na.rm = FALSE, 49 | show.legend = NA, 50 | inherit.aes = TRUE) 51 | { 52 | if (!missing(nudge_x) || !missing(nudge_y)) { 53 | if (!missing(position)) { 54 | stop("You must specify either `position` or `nudge_x`/`nudge_y`.", call. = FALSE) 55 | } 56 | position <- position_nudge(nudge_x, nudge_y) 57 | } 58 | 59 | layer( 60 | data = data, 61 | mapping = mapping, 62 | stat = stat, 63 | geom = GeomMark, 64 | position = position, 65 | show.legend = show.legend, 66 | inherit.aes = inherit.aes, 67 | params = list( 68 | digits = digits, 69 | nsmall = nsmall, 70 | sig.level = sig.level, 71 | mark = mark, 72 | sig.thres = sig.thres, 73 | sep = sep, 74 | parse = parse, 75 | na.rm = na.rm, 76 | ... 77 | ) 78 | ) 79 | } 80 | 81 | #' @rdname geom_mark 82 | #' @format NULL 83 | #' @usage NULL 84 | #' @export 85 | GeomMark <- ggproto("GeomMark", GeomText, 86 | required_aes = c("x", "y", "p.value"), 87 | 88 | default_aes = aes( 89 | r = NA, colour = "black", size = 3.88, angle = 0, hjust = 0.5, 90 | vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2 91 | ), 92 | 93 | draw_panel = function(data, panel_params, coord, digits = 2, 94 | nsmall = 2, sig.level = c(0.05, 0.01, 0.001), 95 | mark = c("*", "**", "***"), sig.thres = NULL, 96 | sep = "", parse = FALSE, na.rm = FALSE) { 97 | stopifnot(length(sig.level) == length(mark)) 98 | if(!is.null(sig.thres)) 99 | data <- dplyr::filter(data, p.value <= sig.thres) 100 | star <- sig_mark(data$p.value, sig.level, mark) 101 | na_idx <- is.na(data$r) 102 | num <- ifelse(na_idx, "", format_number(data$r, digits, nsmall)) 103 | if(parse) { 104 | if(!requireNamespace("latex2exp", quietly = TRUE)) 105 | warning("Need latex2exp package.", call. = FALSE) 106 | parse <- FALSE 107 | } 108 | if(parse) { 109 | label <- paste(num, paste0("{", star, "}"), sep = sep) 110 | data$label <- latex2exp::TeX(label, output = "text") 111 | } else { 112 | data$label <- paste(num, star, sep = sep) 113 | } 114 | GeomText$draw_panel(data, panel_params, coord) 115 | }, 116 | draw_key = draw_key_text 117 | ) 118 | 119 | 120 | -------------------------------------------------------------------------------- /R/geom-num.R: -------------------------------------------------------------------------------- 1 | #' Format number Geom 2 | #' 3 | #' @param digits integer indicating the number of decimal places (round) or 4 | #' significant digits (signif) to be used, the default value is 2. 5 | #' @param nsmall the minimum number of digits to the right of the decimal 6 | #' point in formatting real/complex numbers in non-scientific formats, 7 | #' the default value is 2. 8 | #' @inheritParams ggplot2::layer 9 | #' @inheritParams ggplot2::geom_text 10 | #' @section Aesthetics: 11 | #' \code{geom_number()} understands the following aesthetics (required 12 | #' aesthetics are in bold): 13 | #' \itemize{ 14 | #' \item \strong{\code{x}} 15 | #' \item \strong{\code{y}} 16 | #' \item \strong{\code{num}} 17 | #' \item \code{alpha} 18 | #' \item \code{colour} 19 | #' \item \code{size} 20 | #' \item \code{angle} 21 | #' \item \code{hjust} 22 | #' \item \code{vjust} 23 | #' \item \code{family} 24 | #' \item \code{fontface} 25 | #' \item \code{lineheight} 26 | #' } 27 | #' @importFrom ggplot2 layer ggproto position_nudge GeomText aes draw_key_text 28 | #' @rdname geom_number 29 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 30 | #' @export 31 | geom_number <- function(mapping = NULL, data = NULL, 32 | stat = "identity", position = "identity", 33 | ..., 34 | nudge_x = 0, 35 | nudge_y = 0, 36 | digits = 2, 37 | nsmall = 2, 38 | na.rm = FALSE, 39 | show.legend = NA, 40 | inherit.aes = TRUE) 41 | { 42 | if (!missing(nudge_x) || !missing(nudge_y)) { 43 | if (!missing(position)) { 44 | stop("You must specify either `position` or `nudge_x`/`nudge_y`.", call. = FALSE) 45 | } 46 | position <- position_nudge(nudge_x, nudge_y) 47 | } 48 | layer( 49 | data = data, 50 | mapping = mapping, 51 | stat = stat, 52 | geom = GeomNumber, 53 | position = position, 54 | show.legend = show.legend, 55 | inherit.aes = inherit.aes, 56 | params = list( 57 | digits = digits, 58 | nsmall = nsmall, 59 | na.rm = na.rm, 60 | ... 61 | ) 62 | ) 63 | } 64 | 65 | #' @rdname geom_number 66 | #' @format NULL 67 | #' @usage NULL 68 | #' @export 69 | GeomNumber <- ggproto("GeomNumber", GeomText, 70 | required_aes = c("x", "y", "num"), 71 | default_aes = aes(colour = "black", size = 3.88, angle = 0, hjust = 0.5, 72 | vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2), 73 | draw_panel = function(data, panel_params, coord, digits = 2, 74 | nsmall = 2, na.rm = FALSE) { 75 | data$label <- format_number(data$num, digits, nsmall) 76 | GeomText$draw_panel(data, panel_params, coord) 77 | }, 78 | draw_key = draw_key_text 79 | ) 80 | 81 | 82 | 83 | -------------------------------------------------------------------------------- /R/geom-panel-grid.R: -------------------------------------------------------------------------------- 1 | #' Add panel grid line on correlation plot 2 | #' @description \code{geom_grid} is mainly used with \code{ggcor} or \code{quickcor} 3 | #' function to add a panel grid line on plot region. 4 | #' @param data NULL (default) or a cor_tbl object. 5 | #' @param colour,color colour of grid lines. 6 | #' @param size size of grid lines. 7 | #' @param ... extra params for \code{\link[ggplot2]{geom_segment}}. 8 | #' @importFrom ggplot2 geom_segment aes_string 9 | #' @rdname geom_panel_grid 10 | #' @examples 11 | #' df <- fortify_cor(mtcars) 12 | #' ggcor(df) + geom_panel_grid() 13 | #' require(ggplot2, quietly = TRUE) 14 | #' ggplot(df, aes(x, y)) + geom_panel_grid() 15 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 16 | #' @export 17 | geom_panel_grid <- function(data = NULL, 18 | colour = "grey50", 19 | size = 0.25, 20 | ..., 21 | color = NULL) { 22 | if(!is.null(data)) { 23 | if(!is_cor_tbl(data)) { 24 | stop("Need a cor_tbl object.", call. = FALSE) 25 | } 26 | data <- get_grid_data()(data) 27 | } 28 | if(!is.null(color)) 29 | colour <- color 30 | geom_segment(aes_string(x = "x", y = "y", xend = "xend", yend = "yend"), 31 | data = data %||% get_grid_data(), colour = colour, size = size, 32 | inherit.aes = FALSE, ...) 33 | } 34 | 35 | #' @rdname geom_panel_grid 36 | #' @format NULL 37 | #' @usage NULL 38 | #' @export 39 | add_grid <- function(...) { 40 | warning("`add_grid()` is deprecated. ", 41 | "Use `geom_panel_grid()` instead.", call. = FALSE) 42 | geom_panel_grid(...) 43 | } 44 | 45 | #' @noRd 46 | get_grid_data <- function() { 47 | function(data) { 48 | if(!is_cor_tbl(data)) 49 | stop("Need a cor_tbl.", call. = FALSE) 50 | n <- length(get_col_name(data)) 51 | m <- length(get_row_name(data)) 52 | type <- get_type(data) 53 | show.diag <- get_show_diag(data) 54 | if(type == "full") { 55 | xx <- c(0:n + 0.5, rep_len(0.5, m + 1)) 56 | yy <- c(rep_len(0.5, n + 1), 0:m + 0.5) 57 | xxend <- c(0:n + 0.5, rep_len(n + 0.5, m + 1)) 58 | yyend <- c(rep_len(m + 0.5, n + 1), 0:m + 0.5) 59 | } else if(type == "upper") { 60 | if(show.diag) { 61 | xx <- c(0:n + 0.5, c(n:1 - 0.5, 0.5)) 62 | yy <- c(c(m:1 - 0.5, 0.5), 0:m + 0.5) 63 | xxend <- c(0:n + 0.5, rep_len(n + 0.5, m + 1)) 64 | yyend <- c(rep_len(m + 0.5, n + 1), 0:m + 0.5) 65 | } else { 66 | xx <- c(1:n + 0.5, c(n:2 - 0.5, 1.5)) 67 | yy <- c(c(m:2 - 0.5, 1.5), 1:m + 0.5) 68 | xxend <- c(1:n + 0.5, rep_len(n + 0.5, m)) 69 | yyend <- c(rep_len(m + 0.5, n), 1:m + 0.5) 70 | } 71 | } else { 72 | if(show.diag) { 73 | xx <- c(0:n + 0.5, rep_len(0.5, m + 1)) 74 | yy <- c(rep_len(0.5, n + 1), 0:m + 0.5) 75 | xxend <- c(0:n + 0.5, c(n + 0.5, n:1 + 0.5)) 76 | yyend <- c(c(m + 0.5, m:1 + 0.5), 0:m + 0.5) 77 | } else { 78 | xx <- c(1:n - 0.5, rep_len(0.5, m)) 79 | yy <- c(rep_len(0.5, n), 1:m - 0.5) 80 | xxend <- c(1:n - 0.5, c(n - 0.5, n:2 - 0.5)) 81 | yyend <- c(c(m - 0.5, m:2 - 0.5), 1:m - 0.5) 82 | } 83 | } 84 | new_data_frame(list(x = xx, y = yy, xend = xxend, yend = yyend)) 85 | } 86 | } 87 | 88 | -------------------------------------------------------------------------------- /R/geom-pie2.R: -------------------------------------------------------------------------------- 1 | #' @rdname geom_ring 2 | #' @export 3 | geom_pie2 <- function(mapping = NULL, data = NULL, 4 | stat = "identity", position = "identity", 5 | ..., 6 | remain.fill = NA, 7 | end.radius = 0.5, 8 | steps = 0.1, 9 | na.rm = FALSE, 10 | show.legend = NA, 11 | inherit.aes = TRUE) 12 | { 13 | geom_ring(mapping = mapping, data = data, 14 | stat = stat, position = position, 15 | ..., 16 | remain.fill = remain.fill, 17 | start.radius = 0, 18 | end.radius = end.radius, 19 | steps = steps, 20 | na.rm = na.rm, 21 | show.legend = show.legend, 22 | inherit.aes = inherit.aes) 23 | } 24 | 25 | #' @rdname geom_ring 26 | #' @export 27 | geom_upper_pie2 <- function(mapping = NULL, 28 | data = NULL, 29 | stat = "identity", 30 | position = "identity", 31 | ..., 32 | remain.fill = NA, 33 | end.radius = 0.5, 34 | steps = 0.1, 35 | na.rm = FALSE, 36 | show.legend = NA, 37 | inherit.aes = TRUE) 38 | { 39 | geom_upper_ring(mapping = mapping, 40 | data = data, 41 | stat = stat, 42 | position = position, 43 | ..., 44 | remain.fill = remain.fill, 45 | start.radius = 0, 46 | end.radius = end.radius, 47 | steps = steps, 48 | na.rm = na.rm, 49 | show.legend = show.legend, 50 | inherit.aes = inherit.aes) 51 | } 52 | 53 | #' @rdname geom_ring 54 | #' @export 55 | geom_lower_pie2 <- function(mapping = NULL, 56 | data = NULL, 57 | stat = "identity", 58 | position = "identity", 59 | ..., 60 | remain.fill = NA, 61 | end.radius = 0.5, 62 | steps = 0.1, 63 | na.rm = FALSE, 64 | show.legend = NA, 65 | inherit.aes = TRUE) 66 | { 67 | geom_lower_ring(mapping = mapping, 68 | data = data, 69 | stat = stat, 70 | position = position, 71 | ..., 72 | remain.fill = remain.fill, 73 | start.radius = 0, 74 | end.radius = end.radius, 75 | steps = steps, 76 | na.rm = na.rm, 77 | show.legend = show.legend, 78 | inherit.aes = inherit.aes) 79 | } 80 | -------------------------------------------------------------------------------- /R/geom-shade.R: -------------------------------------------------------------------------------- 1 | #' Shade Geom 2 | #' 3 | #' @param sign scalar numeric value. If less than 0, add shade on cells with 4 | #' negtive \code{r} values. If larger than 0, add shade on cells with positive 5 | #' \code{r} values. If equals 0, add shade on cells except where \code{r} values 6 | #' equals 0. 7 | #' @inheritParams ggplot2::layer 8 | #' @inheritParams ggplot2::geom_segment 9 | #' @section Aesthetics: 10 | #' \code{geom_shade()} understands the following aesthetics (required 11 | #' aesthetics are in bold): 12 | #' \itemize{ 13 | #' \item \strong{\code{x}} 14 | #' \item \strong{\code{y}} 15 | #' \item \strong{\code{r0}} 16 | #' \item \code{alpha} 17 | #' \item \code{colour} 18 | #' \item \code{linetype} 19 | #' \item \code{size} 20 | #' } 21 | #' @rdname geom_shade 22 | #' @importFrom ggplot2 layer ggproto GeomSegment aes draw_key_blank 23 | #' @importFrom grid grobTree 24 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 25 | #' @export 26 | geom_shade <- function(mapping = NULL, data = NULL, 27 | stat = "identity", position = "identity", 28 | ..., 29 | sign = 1, 30 | na.rm = FALSE, 31 | show.legend = NA, 32 | inherit.aes = TRUE) { 33 | layer( 34 | data = data, 35 | mapping = mapping, 36 | stat = stat, 37 | geom = GeomShade, 38 | position = position, 39 | show.legend = show.legend, 40 | inherit.aes = inherit.aes, 41 | params = list( 42 | sign = sign, 43 | na.rm = na.rm, 44 | ... 45 | ) 46 | ) 47 | } 48 | 49 | #' @rdname geom_shade 50 | #' @format NULL 51 | #' @usage NULL 52 | #' @export 53 | GeomShade <- ggproto( 54 | "GeomShade", GeomSegment, 55 | default_aes = aes(colour = "white", size = 0.25, linetype = 1, alpha = NA), 56 | required_aes = c("x", "y", "r0"), 57 | draw_panel = function(self, data, panel_params, coord, linejoin = "mitre", 58 | sign = 1) { 59 | aesthetics <- setdiff(names(data), c("x", "y", "r0")) 60 | polys <- lapply(split(data, seq_len(nrow(data))), function(row) { 61 | if(sign < 0) { 62 | if(row$r0 >= 0) return(grid::nullGrob()) 63 | shade <- point_to_shade(row$x, row$y, row$r0) 64 | aes <- new_data_frame(row[aesthetics])[rep(1, 3), ] 65 | return(GeomSegment$draw_panel(cbind(shade, aes), panel_params, coord)) 66 | } 67 | if(sign > 0) { 68 | if(row$r0 <= 0) return(grid::nullGrob()) 69 | shade <- point_to_shade(row$x, row$y, row$r0) 70 | aes <- new_data_frame(row[aesthetics])[rep(1, 3), ] 71 | return(GeomSegment$draw_panel(cbind(shade, aes), panel_params, coord)) 72 | } 73 | if(sign == 0) { 74 | if(row$r0 == 0) return(grid::nullGrob()) 75 | shade <- point_to_shade(row$x, row$y, row$r0) 76 | aes <- new_data_frame(row[aesthetics])[rep(1, 3), ] 77 | return(GeomSegment$draw_panel(cbind(shade, aes), panel_params, coord)) 78 | } 79 | }) 80 | 81 | ggplot2:::ggname("geom_shade", do.call("grobTree", polys)) 82 | }, 83 | draw_key = draw_key_blank 84 | ) 85 | 86 | 87 | #' @noRd 88 | 89 | point_to_shade <- function(x, y, sign) 90 | { 91 | if(sign > 0) { 92 | xx <- c(x - 0.5, x - 0.5, x) 93 | xend <- c(x, x + 0.5, x + 0.5) 94 | yy <- c(y, y + 0.5, y + 0.5) 95 | yend <- c(y - 0.5, y - 0.5, y) 96 | } 97 | if(sign < 0) { 98 | xx <- c(x, x - 0.5, x - 0.5) 99 | xend <- c(x + 0.5, x + 0.5, x) 100 | yy <- c(y - 0.5, y - 0.5, y) 101 | yend <- c(y, y + 0.5, y + 0.5) 102 | } 103 | new_data_frame(list( 104 | x = xx, 105 | y = yy, 106 | xend = xend, 107 | yend = yend 108 | )) 109 | } 110 | 111 | -------------------------------------------------------------------------------- /R/get-data.R: -------------------------------------------------------------------------------- 1 | #' Helper function to extract cor_tbl. 2 | #' @description These functions are used to quickly obtain the upper 3 | #' trig, lower trig, diagonal, or remove the diagonal of the correlation 4 | #' coefficient matrix. 5 | #' @param x a cor_tbl object. 6 | #' @param show.diag a logical value indicating whether keep the diagonal. 7 | #' @return a modified cor_tbl object. 8 | #' @importFrom dplyr filter 9 | #' @rdname extract_cor_tbl 10 | #' @examples 11 | #' df <- fortify_cor(mtcars) 12 | #' quickcor(df) + geom_colour() 13 | #' 14 | #' ## exclude upper 15 | #' df %>% get_lower_data() %>% 16 | #' quickcor() + geom_colour() 17 | #' 18 | #' ## exclude lower 19 | #' df %>% get_upper_data(show.diag = FALSE) %>% 20 | #' quickcor() + geom_colour() 21 | #' 22 | #' ## get the diagonal 23 | #' df %>% get_diag_data() %>% 24 | #' quickcor() + geom_colour() 25 | #' 26 | #' ## exclude the diagonal 27 | #' df %>% get_diag_tri() %>% 28 | #' quickcor() + geom_colour() 29 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 30 | #' @export 31 | get_lower_data <- function(x, show.diag = TRUE) 32 | { 33 | stopifnot(is_cor_tbl(x)) 34 | if(!is_symmet(x)) { 35 | warning("Just supports symmetric matrix.", call. = FALSE) 36 | return(x) 37 | } 38 | n <- length(get_col_name(x)) 39 | if(isTRUE(show.diag)) { 40 | x <- dplyr::filter(x, .row.id + .col.id <= n + 1) 41 | } else { 42 | x <- dplyr::filter(x, .row.id + .col.id < n + 1) 43 | } 44 | attr(x, "type") <- "lower" 45 | attr(x, "show.diag") <- show.diag 46 | x 47 | } 48 | 49 | #' @importFrom dplyr filter 50 | #' @rdname extract_cor_tbl 51 | #' @export 52 | get_upper_data <- function(x, show.diag = TRUE) 53 | { 54 | stopifnot(is_cor_tbl(x)) 55 | if(!is_symmet(x)) { 56 | warning("Just supports symmetric matrix.", call. = FALSE) 57 | return(x) 58 | } 59 | n <- length(get_col_name(x)) 60 | if(isTRUE(show.diag)) { 61 | x <- dplyr::filter(x, .row.id + .col.id >= n + 1) 62 | } else { 63 | x <- dplyr::filter(x, .row.id + .col.id > n + 1) 64 | } 65 | attr(x, "type") <- "upper" 66 | attr(x, "show.diag") <- show.diag 67 | x 68 | } 69 | 70 | #' @importFrom dplyr filter 71 | #' @rdname extract_cor_tbl 72 | #' @export 73 | get_diag_tri <- function(x) 74 | { 75 | stopifnot(is_cor_tbl(x)) 76 | if(!is_symmet(x)) { 77 | warning("Just supports symmetric matrix.", call. = FALSE) 78 | return(x) 79 | } 80 | n <- length(get_col_name(x)) 81 | x <- dplyr::filter(x, .row.id + .col.id != n + 1) 82 | if(get_type(x) %in% c("upper", "lower")) 83 | attr(x, "show.diag") <- FALSE 84 | x 85 | } 86 | 87 | #' @importFrom dplyr filter 88 | #' @rdname extract_cor_tbl 89 | #' @export 90 | get_diag_data <- function(x) 91 | { 92 | stopifnot(is_cor_tbl(x)) 93 | if(!is_symmet(x)) { 94 | warning("Just supports symmetric matrix.", call. = FALSE) 95 | return(x) 96 | } 97 | n <- length(get_col_name(x)) 98 | dplyr::filter(x, .row.id + .col.id == n + 1) 99 | } 100 | 101 | #' @rdname extract_cor_tbl 102 | #' @export 103 | is_symmet <- function(x) { 104 | stopifnot(is_cor_tbl(x)) 105 | col.name <- get_col_name(x) 106 | row.name <- get_row_name(x) 107 | if((length(col.name) != length(row.name)) || !all(col.name == row.name)) { 108 | return(FALSE) 109 | } 110 | TRUE 111 | } 112 | 113 | #' Create cor_tbl extractor function 114 | #' @description This function returns another function that can extract cor_tbl 115 | #' subset from a cor_tbl object. 116 | #' @param type a string, "full" (default), "upper" or "lower", display full, 117 | #' lower triangular or upper triangular matrix. 118 | #' @param show.diag a logical value indicating whether keep the diagonal. 119 | #' @param ... extra filter params, see Details. 120 | #' @details This function is mainly used in \code{ggplot2} geom_*() functions, 121 | #' where data is filtered based on the \code{...} parameter, then subsets 122 | #' are extracted based on the type and show.diag parameters. 123 | #' @return extractor function 124 | #' @importFrom dplyr filter 125 | #' @rdname get_data 126 | #' @examples 127 | #' ## arrange different elements in upper and lower 128 | #' quickcor(mtcars) + 129 | #' geom_colour(data = get_data(type = "lower")) + 130 | #' geom_ellipse2(data = get_data(type = "upper")) + 131 | #' add_diag_label() + 132 | #' remove_axis() 133 | #' 134 | #' quickcor(mtcars, cor.test = TRUE) + 135 | #' geom_ellipse2(data = get_data(type = "upper")) + 136 | #' geom_mark(data = get_data(type = "lower")) + 137 | #' add_diag_label() + 138 | #' remove_axis() 139 | #' @seealso \code{\link[dplyr]{filter}}. 140 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 141 | #' @export 142 | get_data <- function(..., type = "full", show.diag = FALSE) 143 | { 144 | type <- match.arg(type, c("full", "upper", "lower", "diag")) 145 | function(data) { 146 | data <- dplyr::filter(data, ...) 147 | switch (type, 148 | full = if(isTRUE(show.diag)) data else get_diag_tri(data), 149 | upper = get_upper_data(data, show.diag = show.diag), 150 | lower = get_lower_data(data, show.diag = show.diag), 151 | diag = get_diag_data(data) 152 | ) 153 | } 154 | } 155 | 156 | -------------------------------------------------------------------------------- /R/ggcor.R: -------------------------------------------------------------------------------- 1 | #' Create a correlation plot 2 | #' @description This function is the equivalent of \code{\link[ggplot2]{ggplot}} 3 | #' in ggplot2. It takes care of setting up the position of axis and legend for 4 | #' the plot based on the plot type. 5 | #' @param data cor_tbl object. 6 | #' @param mapping NULL (default) or a list of aesthetic mappings to use for plot. 7 | #' @param axis.x.position,axis.y.position the position of the axis. 'auto' (default) 8 | #' is set according to the plot type, 'bottom' or 'top' for x axes, 'left' or 'right' 9 | #' for y axes. 10 | #' @param axis.label.drop logical value (default is TRUE). When type of plot is 'upper' 11 | #' or 'lower' and 'show.diag' is FALSE, do you need to remove the blank coordinate 12 | #' label. 13 | #' @return an object of class gg onto which layers, scales, etc. can be added. 14 | #' @importFrom ggplot2 ggplot ggplot_add aes_string scale_x_continuous scale_y_continuous 15 | #' @importFrom utils modifyList 16 | #' @rdname ggcor 17 | #' @examples 18 | #' df <- fortify_cor(mtcars) 19 | #' ggcor(df) 20 | #' df01 <- fortify_cor(mtcars, type = "lower", show.diag = FALSE) 21 | #' ggcor(df01, axis.label.drop = TRUE) 22 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 23 | #' @export 24 | ggcor <- function(data, 25 | mapping = NULL, 26 | axis.x.position = "auto", 27 | axis.y.position = "auto", 28 | axis.label.drop = TRUE) 29 | { 30 | if(!is_cor_tbl(data)) 31 | stop("'data' needs a cor_tbl.", call. = FALSE) 32 | type <- get_type(data) 33 | show.diag <- get_show_diag(data) 34 | col.names <- get_col_name(data) 35 | row.names <- rev(get_row_name(data)) 36 | base.aes <- aes_string(".col.id", ".row.id") 37 | mapping <- if(is.null(mapping)) base.aes else modifyList(base.aes, mapping) 38 | # handle axis setting 39 | axis.x.position <- match.arg(axis.x.position, c("auto", "bottom", "top")) 40 | axis.y.position <- match.arg(axis.y.position, c("auto", "left", "right")) 41 | if(axis.x.position == "auto") { 42 | axis.x.position <- switch (type, 43 | full = "bottom", 44 | lower = "bottom", 45 | upper = "top") 46 | } 47 | if(axis.y.position == "auto") { 48 | axis.y.position <- switch (type, 49 | full = "left", 50 | lower = "left", 51 | upper = "right") 52 | } 53 | axis.x.breaks <- 1:length(col.names) 54 | axis.x.labels <- col.names 55 | axis.y.breaks <- 1:length(row.names) 56 | axis.y.labels <- row.names 57 | if(axis.label.drop) { 58 | if(isFALSE(show.diag)) { 59 | if(type == "upper") { 60 | axis.x.breaks <- axis.x.breaks[-1] 61 | axis.x.labels <- axis.x.labels[-1] 62 | axis.y.breaks <- axis.y.breaks[-1] 63 | axis.y.labels <- axis.y.labels[-1] 64 | } 65 | if(type == "lower") { 66 | axis.x.breaks <- axis.x.breaks[-length(col.names)] 67 | axis.x.labels <- axis.x.labels[-length(col.names)] 68 | axis.y.breaks <- axis.y.breaks[-length(row.names)] 69 | axis.y.labels <- axis.y.labels[-length(row.names)] 70 | } 71 | } 72 | } 73 | 74 | p <- ggplot(data = data, mapping = mapping, environment = parent.frame()) + 75 | scale_x_continuous(expand = c(0, 0), breaks = axis.x.breaks, labels = axis.x.labels, 76 | position = axis.x.position)+ 77 | scale_y_continuous(expand = c(0, 0), breaks = axis.y.breaks, labels = axis.y.labels, 78 | position = axis.y.position) 79 | class(p) <- c("ggcor", class(p)) 80 | p 81 | } 82 | -------------------------------------------------------------------------------- /R/guide-colourbar2.R: -------------------------------------------------------------------------------- 1 | #' Colourbar legend for upper-lower triangle aesthetics 2 | #' 3 | #' @description This function is equivalent to [ggplot2::guide_colourbar()] but 4 | #' works for upper-lower triangle aesthetics. 5 | #' 6 | #' @inheritParams ggplot2::guide_colourbar 7 | #' 8 | #' @return a guide object 9 | #' 10 | #' @importFrom grid is.unit unit 11 | #' @importFrom digest digest 12 | #' @importFrom ggplot2 waiver 13 | #' @rdname guide_colourbar2 14 | #' @export 15 | guide_colourbar2 <- function(title = waiver(), 16 | title.position = NULL, 17 | title.theme = NULL, 18 | title.hjust = NULL, 19 | title.vjust = NULL, 20 | label = TRUE, 21 | label.position = NULL, 22 | label.theme = NULL, 23 | label.hjust = NULL, 24 | label.vjust = NULL, 25 | barwidth = NULL, 26 | barheight = NULL, 27 | nbin = 20, 28 | raster = TRUE, 29 | ticks = TRUE, 30 | draw.ulim = TRUE, 31 | draw.llim = TRUE, 32 | direction = NULL, 33 | default.unit = "line", 34 | reverse = FALSE, 35 | order = 0, 36 | ...) 37 | { 38 | if (!is.null(barwidth) && !is.unit(barwidth)) { 39 | barwidth <- unit(barwidth, default.unit) 40 | } 41 | if (!is.null(barheight) && !is.unit(barheight)) { 42 | barheight <- unit(barheight, default.unit) 43 | } 44 | guide <- list( 45 | title = title, 46 | title.position = title.position, 47 | title.theme = title.theme, 48 | title.hjust = title.hjust, 49 | title.vjust = title.vjust, 50 | label = label, 51 | label.position = label.position, 52 | label.theme = label.theme, 53 | label.hjust = label.hjust, 54 | label.vjust = label.vjust, 55 | barwidth = barwidth, 56 | barheight = barheight, 57 | nbin = nbin, 58 | raster = raster, 59 | ticks = ticks, 60 | draw.ulim = draw.ulim, 61 | draw.llim = draw.llim, 62 | direction = direction, 63 | default.unit = default.unit, 64 | reverse = reverse, 65 | order = order, 66 | available_aes = c("upper_colour", "upper_fill", 67 | "lower_colour", "lower_fill"), 68 | ..., name = "colourbar2" 69 | ) 70 | class(guide) <- c("guide", "colourbar2", "colorbar") 71 | guide 72 | } 73 | #' @rdname guide_colourbar2 74 | #' @export 75 | guide_colorbar2 <- guide_colourbar2 76 | 77 | #' @importFrom scales discard 78 | #' @importFrom stats setNames 79 | #' @importFrom ggplot2 guide_train 80 | #' @export 81 | guide_train.colourbar2 <- function(guide, scale, aesthetic = NULL) { 82 | if (length(intersect(scale$aesthetics, c( 83 | "upper_colour", "upper_fill", 84 | "lower_colour", "lower_fill"))) == 0) { 85 | warning("colourbar2 guide needs upper_colour, upper_fill, ", 86 | "lower_colour, lower_fill scales.") 87 | return(NULL) 88 | } 89 | if (scale$is_discrete()) { 90 | warning("colourbar2 guide needs continuous scales.") 91 | return(NULL) 92 | } 93 | breaks <- scale$get_breaks() 94 | if (length(breaks) == 0 || all(is.na(breaks))) { 95 | return() 96 | } 97 | ticks <- as.data.frame(setNames( 98 | list(scale$map(breaks)), 99 | aesthetic %||% scale$aesthetics[1] 100 | ), stringsAsFactors = FALSE) 101 | ticks$.value <- breaks 102 | ticks$.label <- scale$get_labels(breaks) 103 | guide$key <- ticks 104 | .limits <- scale$get_limits() 105 | .bar <- discard(pretty(.limits, n = guide$nbin), scale$get_limits()) 106 | if (length(.bar) == 0) { 107 | .bar <- unique(.limits) 108 | } 109 | guide$bar <- new_data_frame(list( 110 | colour = scale$map(.bar), value = .bar, 111 | stringsAsFactors = FALSE 112 | )) 113 | if (guide$reverse) { 114 | guide$key <- guide$key[nrow(guide$key):1, ] 115 | guide$bar <- guide$bar[nrow(guide$bar):1, ] 116 | } 117 | guide$hash <- with(guide, digest::digest(list( 118 | title, key$.label, 119 | bar, name 120 | ))) 121 | guide 122 | } 123 | -------------------------------------------------------------------------------- /R/matrix-order.R: -------------------------------------------------------------------------------- 1 | #' Reorder Matrices 2 | #' @description Tries to find an order for matrix by different cluster methods. 3 | #' @param x a matrix-like object. 4 | #' @param is.cor logical value (defaults to TRUE) indicating wheater 5 | #' \code{x} is a correlation matrix. 6 | #' @param k integer, the number of cluster group. 7 | #' @param cluster.method a character string with the name of agglomeration method. 8 | #' @param ... extra params passing to \code{\link[stats]{hclust}}. 9 | #' @details Now it just supports for square matrix. 10 | #' @return a numeric vector of new order. 11 | #' @importFrom stats as.dist dist hclust 12 | #' @rdname matrix_order 13 | #' @examples 14 | #' m <- matrix(rnorm(25), nrow = 5) 15 | #' matrix_order(m) 16 | #' @seealso \code{\link[stats]{hclust}}. 17 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 18 | #' @export 19 | matrix_order <- function(x, 20 | is.cor = TRUE, 21 | k = 2, 22 | cluster.method = "complete", 23 | ...) 24 | { 25 | if(!is.matrix(x)) 26 | x <- as.matrix(x) 27 | if(isTRUE(is.cor)) { 28 | cluster <- hclust(as.dist(1 - x), cluster.method, ...) 29 | hc.rect.df <- tidy_hc_rect(x, k, cluster.method, ...) 30 | } else { 31 | row.cluster <- hclust(dist(x)) 32 | col.cluster <- hclust(dist(t(x))) 33 | hc.rect.df <- NULL 34 | } 35 | if(isTRUE(is.cor)) { 36 | list(row.order = cluster$order, 37 | col.order = cluster$order, 38 | hc.rect.df = hc.rect.df) 39 | } else { 40 | list(row.order = row.cluster$order, 41 | col.order = col.cluster$order, 42 | hc.rect.df = hc.rect.df) 43 | } 44 | } 45 | 46 | #' @importFrom stats hclust cutree 47 | #' @rdname matrix_order 48 | #' @export 49 | tidy_hc_rect <- function(x, 50 | k = 2, 51 | cluster.method = "complete", 52 | ...) 53 | { 54 | if(inherits(x, "hc_rect_df")) { 55 | return(x) 56 | } 57 | n <- nrow(x) 58 | tree <- hclust(as.dist(1 - x), cluster.method, ...) 59 | hc <- cutree(tree, k = k) 60 | clustab <- table(hc)[unique(hc[tree$order])] 61 | cu <- c(0, cumsum(clustab)) 62 | 63 | structure(.Data = new_data_frame( 64 | list(xmin = cu[-(k + 1)] + 0.5, 65 | ymin = n - cu[-(k + 1)] + 0.5, 66 | xmax = cu[-1] + 0.5, 67 | ymax = n - cu[-1] + 0.5)), 68 | class = c("hc_rect_df", "data.frame")) 69 | } 70 | -------------------------------------------------------------------------------- /R/reexport.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | ggplot2::ggplot_add 3 | 4 | #' @export 5 | ggplot2::aes 6 | 7 | #' @export 8 | dplyr::`%>%` 9 | 10 | #' @export 11 | dplyr::filter 12 | 13 | #' @export 14 | dplyr::mutate 15 | 16 | #' @export 17 | dplyr::group_by 18 | 19 | #' @export 20 | dplyr::ungroup 21 | 22 | #' @export 23 | tibble::as_tibble 24 | 25 | #' @export 26 | tidygraph::as_tbl_graph 27 | 28 | #' @export 29 | igraph::as.igraph 30 | -------------------------------------------------------------------------------- /R/remove-axis.R: -------------------------------------------------------------------------------- 1 | #' Remove axis elements. 2 | #' @description A simple wrapper of the \code{\link[ggplot2]{theme}} function 3 | #' to quickly remove axis elements. 4 | #' @param index 'all' (default), 'x' or 'y' axis will be removed. 5 | #' @return The theme. 6 | #' @importFrom ggplot2 theme element_blank 7 | #' @rdname remove_axis 8 | #' @examples 9 | #' quickcor(mtcars) + geom_circle2() + remove_axis() 10 | #' quickcor(mtcars) + geom_circle2() + remove_axis("x") 11 | #' quickcor(mtcars) + geom_circle2() + remove_axis("y") 12 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 13 | #' @export 14 | remove_axis <- function(index = c("all", "x", "y")) { 15 | index <- match.arg(index) 16 | thm_mv_x <- ggplot2::theme( 17 | axis.title.x = element_blank(), 18 | axis.title.x.top = element_blank(), 19 | axis.title.x.bottom = element_blank(), 20 | axis.text.x = element_blank(), 21 | axis.text.x.top = element_blank(), 22 | axis.text.x.bottom = element_blank(), 23 | axis.ticks.x = element_blank(), 24 | axis.ticks.x.top = element_blank(), 25 | axis.ticks.x.bottom = element_blank(), 26 | axis.line.x = element_blank(), 27 | axis.line.x.top = element_blank(), 28 | axis.line.x.bottom = element_blank() 29 | ) 30 | thm_mv_y <- ggplot2::theme( 31 | axis.title.y = element_blank(), 32 | axis.title.y.left = element_blank(), 33 | axis.title.y.right = element_blank(), 34 | axis.text.y = element_blank(), 35 | axis.text.y.left = element_blank(), 36 | axis.text.y.right = element_blank(), 37 | axis.ticks.y = element_blank(), 38 | axis.ticks.y.left = element_blank(), 39 | axis.ticks.y.right = element_blank(), 40 | axis.line.y = element_blank(), 41 | axis.line.y.left = element_blank(), 42 | axis.line.y.right = element_blank() 43 | ) 44 | if(index == "all") { 45 | thm_mv_x + thm_mv_y 46 | } else if (index == "x"){ 47 | thm_mv_x 48 | } else { 49 | thm_mv_y 50 | } 51 | } 52 | 53 | #' @rdname remove_axis 54 | #' @export 55 | remove_all_axis <- function() { 56 | remove_axis("all") 57 | } 58 | 59 | #' @rdname remove_axis 60 | #' @export 61 | remove_x_axis <- function() { 62 | remove_axis("x") 63 | } 64 | 65 | #' @rdname remove_axis 66 | #' @export 67 | remove_y_axis <- function() { 68 | remove_axis("y") 69 | } 70 | -------------------------------------------------------------------------------- /R/scale-gradient2n.R: -------------------------------------------------------------------------------- 1 | #' Colour scales for correlation plot 2 | #' 3 | #' @description This set of scales defines new fill scales for correlation matrix plot 4 | #' equivalent to the ones already defined by ggplot2. 5 | #' 6 | #' @return A ggproto object inheriting from `Scale` 7 | #' @inheritParams ggplot2::scale_fill_gradient2 8 | #' @param colours,colors vector of colours to use for n-colour gradient. 9 | #' @param limits a numeric vector of length two providing limits of the scale. 10 | #' @importFrom scales gradient_n_pal 11 | #' @importFrom ggplot2 continuous_scale 12 | #' @rdname scale_colour 13 | #' @examples 14 | #' df <- data.frame(x = rep(1:10, 10), 15 | #' y = rep(1:10, each = 10), 16 | #' z = runif(100, -1, 1)) 17 | #' library(ggplot2) 18 | #' ggplot(df, aes(x, y, fill = z)) + 19 | #' geom_tile() + 20 | #' scale_fill_gradient2n() 21 | #' 22 | #' ggplot(df, aes(x, y, colour = z)) + 23 | #' geom_point(size = 4) + 24 | #' scale_colour_gradient2n() 25 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 26 | #' @export 27 | scale_colour_gradient2n <- function(..., 28 | colours, 29 | midpoint = 0, 30 | limits = NULL, 31 | space = "Lab", 32 | values = NULL, 33 | na.value = "grey50", 34 | guide = "colourbar", 35 | aesthetics = "colour", 36 | colors = NULL) { 37 | colours <- if (missing(colours)) colors else colours 38 | colours <- colours %||% red_blue() 39 | continuous_scale(aesthetics, 40 | "gradient2n", 41 | scales::gradient_n_pal(colours, values, space), 42 | na.value = na.value, 43 | guide = guide, 44 | ..., 45 | limits = limits, 46 | rescaler = mid_rescaler(mid = midpoint)) 47 | } 48 | 49 | #' @rdname scale_colour 50 | #' @export 51 | scale_color_gradient2n <- scale_colour_gradient2n 52 | 53 | #' @rdname scale_colour 54 | #' @export 55 | scale_fill_gradient2n <- function(..., 56 | colours, 57 | midpoint = 0, 58 | limits = NULL, 59 | space = "Lab", 60 | values = NULL, 61 | na.value = "grey50", 62 | guide = "colourbar", 63 | aesthetics = "fill", 64 | colors = NULL) { 65 | colours <- if (missing(colours)) colors else colours 66 | colours <- colours %||% red_blue() 67 | continuous_scale(aesthetics, 68 | "gradient2n", 69 | scales::gradient_n_pal(colours, values, space), 70 | na.value = na.value, 71 | guide = guide, 72 | ..., 73 | limits = limits, 74 | rescaler = mid_rescaler(mid = midpoint)) 75 | } 76 | 77 | #' @noRd 78 | mid_rescaler <- function(mid) { 79 | function(x, to = c(0, 1), from = range(x, na.rm = TRUE)) { 80 | scales::rescale_mid(x, to, from, mid) 81 | } 82 | } 83 | 84 | -------------------------------------------------------------------------------- /R/scale-radius.R: -------------------------------------------------------------------------------- 1 | #' Scale radius 2 | #' @inheritParams ggplot2::scale_size 3 | #' @param midpoint the midpoint (in data value) of the diverging scale. Defaults to 0. 4 | #' @rdname scale_radius 5 | #' 6 | #' @importFrom scales rescale_pal 7 | #' @importFrom ggplot2 continuous_scale 8 | #' @export 9 | scale_radius_area <- function(..., range = c(-1, 1), midpoint = 0, guide = "legend") { 10 | ggplot2::continuous_scale(c("r0", "upper_r0", "lower_r0"), "radius", 11 | palette = scales::rescale_pal(range), 12 | rescaler = mid_rescaler(midpoint), guide = guide, ...) 13 | } 14 | -------------------------------------------------------------------------------- /R/theme-cor.R: -------------------------------------------------------------------------------- 1 | #' Create the default ggcor theme 2 | #' @details The theme_cor, with no axis title, no background, no grid, 3 | #' made some adjustments to the x-axis label. 4 | #' @param legend.position the position of legends ("none", "left", "right", 5 | #' "bottom", "top", or two-element numeric vector). 6 | #' @param ... extra params passing to \code{\link[ggplot2]{theme}}. 7 | #' @return The theme. 8 | #' @importFrom ggplot2 theme element_text element_blank element_rect element_line 9 | #' @rdname theme_cor 10 | #' @examples 11 | #' require(ggplot2, quietly = TRUE) 12 | #' df <- fortify_cor(mtcars) 13 | #' ggcor(df) + geom_raster(aes(fill = r)) + theme_cor() 14 | #' @author Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 15 | #' @export 16 | theme_cor <- function(legend.position = "right", 17 | ...) 18 | { 19 | theme( 20 | axis.text = element_text(size = 10.5, colour = "black"), 21 | axis.title = element_blank(), 22 | axis.line = element_blank(), 23 | axis.text.x.top = element_text(angle = 45, hjust = 0, vjust = 0), 24 | axis.text.x.bottom = element_text(angle = 45, hjust = 1, vjust = 1), 25 | panel.grid = element_blank(), 26 | panel.background = element_rect(fill = NA), 27 | legend.position = legend.position, 28 | ... 29 | ) 30 | } 31 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' @noRd 2 | make_list_names <- function(x, pre = "X", sep = "") 3 | { 4 | stopifnot(is.list(x)) 5 | n <- length(x) 6 | name <- names(x) 7 | if(!is.null(name) && all(name != "" & !is.na(name))) 8 | return(x) 9 | if(is.null(x)) { 10 | names(x) <- paste0(pre, sep, seq_len(n)) 11 | } 12 | if(all(name == "" | is.na(name))) { 13 | names(x) <- paste0(pre, sep, seq_len(n)) 14 | } else { 15 | idx <- name == "" | is.na(name) 16 | name[idx] <- paste0(pre, sep, sum(idx)) 17 | names(x) <- make.unique(name) 18 | } 19 | return(x) 20 | } 21 | 22 | #' @noRd 23 | new_data_frame <- function(x = list(), n = NULL) { 24 | if (length(x) != 0 && is.null(names(x))) stop("Elements must be named", call. = FALSE) 25 | lengths <- vapply(x, length, integer(1)) 26 | if (is.null(n)) { 27 | n <- if (length(x) == 0 || min(lengths) == 0) 0 else max(lengths) 28 | } 29 | for (i in seq_along(x)) { 30 | if (lengths[i] == n) next 31 | if (lengths[i] != 1) stop("Elements must equal the number of rows or 1", call. = FALSE) 32 | x[[i]] <- rep(x[[i]], n) 33 | } 34 | 35 | class(x) <- "data.frame" 36 | 37 | attr(x, "row.names") <- .set_row_names(n) 38 | x 39 | } 40 | 41 | #' @noRd 42 | sig_mark <- function(p.value, 43 | sig.level = c(0.05, 0.01, 0.001), 44 | mark = c("*", "**", "***")) { 45 | if(!is.numeric(p.value)) 46 | p.value <- as.numeric(p.value) 47 | ord <- order(sig.level) 48 | sig.level <- sig.level[ord] 49 | mark <- mark[ord] 50 | brks <- c(0, sig.level, 1) 51 | lbs <- c(mark, "") 52 | pp <- cut(p.value, breaks = brks, labels = lbs, include.lowest = FALSE, right = TRUE) 53 | ifelse(p.value == 0, mark[1], as.character(pp)) 54 | } 55 | 56 | #' @noRd 57 | format_number <- function(x, digits = 2, nsmall = 2) { 58 | if(!is.numeric(x)) 59 | stop("`x` must be a numeric vector.", call. = FALSE) 60 | x <- round(x, digits = digits) 61 | format(x, nsmall = nsmall) 62 | } 63 | 64 | #' @noRd 65 | ggname <- function (prefix, grob) 66 | { 67 | grob$name <- grid::grobName(grob, prefix) 68 | grob 69 | } 70 | 71 | #' @noRd 72 | `%||%` <- function(x, y) 73 | { 74 | if(is.null(x)) y else x 75 | } 76 | 77 | #' @noRd 78 | aes_short_to_long <- function(data, prefix, short.aes) 79 | { 80 | if(is.null(data)) { 81 | return(data) 82 | } 83 | if (any(names(data) == "color")) { 84 | names(data)[names(data) == "color"] <- "colour" 85 | } 86 | short.aes.id <- names(data) %in% short.aes 87 | names(data)[short.aes.id] <- paste(prefix, names(data)[short.aes.id], 88 | sep = "_") 89 | data 90 | } 91 | 92 | #' @noRd 93 | aes_long_to_short <- function(data, prefix, long.aes) 94 | { 95 | if(is.null(data)) { 96 | return(data) 97 | } 98 | long.color <- paste(prefix, "color", sep = "_") 99 | if (any(names(data) == long.color)) { 100 | names(data)[names(data) == long.color] <- paste(prefix, "colour", sep = "_") 101 | } 102 | long.aes.id <- names(data) %in% long.aes 103 | names(data)[long.aes.id] <- gsub(paste0(prefix, "_"), "", 104 | names(data)[long.aes.id], fixed = TRUE) 105 | data 106 | } 107 | 108 | #' @noRd 109 | remove_short_aes <- function(data, short.aes) { 110 | data[ , !names(data) %in% short.aes, drop = FALSE] 111 | } 112 | 113 | #' @noRd 114 | short_aes <- c("color", "colour", "fill", "size", "linetype", "alpha", "r0", 115 | "width", "height", "n", "ratio") 116 | 117 | #' @noRd 118 | long_aes_upper <- paste("upper", short_aes, sep = "_") 119 | 120 | #' @noRd 121 | long_aes_lower <- paste("lower", short_aes, sep = "_") 122 | 123 | #' @noRd 124 | utils::globalVariables( 125 | c( 126 | "r", 127 | "p.value", 128 | ".row.id", 129 | ".col.id", 130 | ".group", 131 | "spec", 132 | "env", 133 | ".start.filter", 134 | ".end.filter" 135 | ) 136 | ) 137 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function(libname, pkgname ) 2 | { 3 | options( 4 | ggcor.fill.pal = c("#67001F", "#B2182B", "#D6604D", "#F4A582", 5 | "#FDDBC7", "#F7F7F7", "#D1E5F0", "#92C5DE", 6 | "#4393C3", "#2166AC", "#053061"), 7 | ggcor.plot.style = "corrplot", 8 | ggcor.link.inherit.aes = TRUE) 9 | } 10 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | ```{r, include = FALSE} 6 | knitr::opts_chunk$set( 7 | message = FALSE, 8 | collapse = TRUE, 9 | comment = "#>", 10 | fig.path = "man/figures/README-", 11 | out.width = "100%" 12 | ) 13 | ``` 14 | 15 | # ggcor 16 | 17 | [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 18 | 19 | 20 | The goal of `ggcor` is to to provide a set of functions that be used to visualize simply and directly a correlation matrix based on 'ggplot2'. 21 | 22 | ## Installation 23 | 24 | Now `ggcor` is not on cran, You can install the development version of ggcor from [GitHub](https://github.com/) with: 25 | 26 | ``` r 27 | # install.packages("devtools") 28 | devtools::install_github("houyunhuang/ggcor") 29 | ``` 30 | ## Draw correlation plot quickly 31 | 32 | This is a basic example which shows you how to draw correlation plot quickly: 33 | 34 | ```{r example01} 35 | library(ggplot2) 36 | library(ggcor) 37 | quickcor(mtcars) + geom_colour() 38 | quickcor(mtcars, type = "upper") + geom_circle2() 39 | quickcor(mtcars, cor.test = TRUE) + 40 | geom_square(data = get_data(type = "lower", show.diag = FALSE)) + 41 | geom_mark(data = get_data(type = "upper", show.diag = FALSE), size = 2.5) + 42 | geom_abline(slope = -1, intercept = 12) 43 | ``` 44 | 45 | ## Mantel test plot 46 | 47 | ```{r example03} 48 | library(vegan) 49 | library(dplyr) 50 | data("varechem") 51 | data("varespec") 52 | set.seed(20191224) 53 | sam_grp <- sample(paste0("sample", 1:3), 24, replace = TRUE) 54 | mantel01 <- fortify_mantel(varespec, varechem, group = sam_grp, 55 | spec.select = list(spec01 = 1:5, 56 | spec02 = 6:12, 57 | spec03 = 7:18, 58 | spec04 = 20:29, 59 | spec05 = 30:44), 60 | mantel.fun = "mantel.randtest") 61 | quickcor(mantel01, legend.title = "Mantel's r") + 62 | geom_colour() + geom_cross() + facet_grid(rows = vars(.group)) 63 | mantel02 <- fortify_mantel(varespec, varechem, 64 | spec.select = list(1:10, 5:14, 7:22, 9:32)) %>% 65 | mutate(r = cut(r, breaks = c(-Inf, 0.25, 0.5, Inf), 66 | labels = c("<0.25", "0.25-0.5", ">=0.5"), 67 | right = FALSE), 68 | p.value = cut(p.value, breaks = c(-Inf, 0.001, 0.01, 0.05, Inf), 69 | labels = c("<0.001", "0.001-0.01", "0.01-0.05", ">=0.05"), 70 | right = FALSE)) 71 | quickcor(varechem, type = "upper") + geom_square() + 72 | add_link(mantel02, mapping = aes(colour = p.value, size = r), 73 | diag.label = TRUE) + 74 | scale_size_manual(values = c(0.5, 1.5, 3)) + 75 | add_diag_label() + remove_axis("x") 76 | ``` 77 | 78 | # network 79 | 80 | ```{r} 81 | library(tidygraph) 82 | library(ggraph) 83 | net <- fast_correlate(varespec) %>% 84 | as_tbl_graph(r.thres = 0.5, p.thres = 0.05) %>% 85 | mutate(degree = tidygraph::centrality_degree(mode = "all")) 86 | 87 | ggraph(net, "circle") + 88 | geom_edge_fan(aes(edge_width = r, edge_linetype = r < 0), 89 | edge_colour = "grey80", show.legend = FALSE) + 90 | geom_node_point(aes(size = degree, colour = name), 91 | show.legend = FALSE) + 92 | geom_node_text(aes(x = x * 1.08, y = y * 1.08, 93 | angle = -((-node_angle(x, y) + 90) %% 180) + 90, 94 | label = name), size = 4, hjust= "outward", 95 | show.legend = FALSE) + 96 | scale_edge_color_gradientn(colours = c("blue", "red")) + 97 | scale_edge_width_continuous(range = c(0.1, 1)) + 98 | coord_fixed(xlim = c(-1.5, 1.5), ylim = c(-1.5, 1.5)) + 99 | theme_graph() 100 | 101 | ``` 102 | 103 | # general heatmap 104 | 105 | ```{r} 106 | mat <- matrix(rnorm(120), nrow = 15) 107 | cor_tbl(extra.mat = list(mat = mat)) %>% 108 | quickcor(mapping = aes(fill = mat)) + geom_colour() 109 | ``` 110 | 111 | # upper and lower with different geom 112 | 113 | ```{r} 114 | d <- dist(t(mtcars)) 115 | correlate(mtcars, cor.test = TRUE) %>% 116 | as_cor_tbl(extra.mat = list(dist = d)) %>% 117 | quickcor() + 118 | geom_upper_square(aes(upper_fill = r, upper_r0 = r)) + 119 | geom_lower_colour(aes(lower_fill = dist)) + 120 | geom_diag_label() + 121 | remove_all_axis() 122 | ``` 123 | 124 | -------------------------------------------------------------------------------- /ggcor.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /man/add_link.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-link.R 3 | \name{add_link} 4 | \alias{add_link} 5 | \title{Add other association link plot on correlation plot.} 6 | \usage{ 7 | add_link( 8 | df, 9 | mapping = NULL, 10 | spec.key = "spec", 11 | env.key = "env", 12 | curvature = NULL, 13 | spec.label.hspace = NULL, 14 | spec.label.vspace = 0, 15 | on.left = FALSE, 16 | diag.label = FALSE, 17 | extra.params = extra_params(), 18 | ... 19 | ) 20 | } 21 | \arguments{ 22 | \item{df}{a data frame object.} 23 | 24 | \item{mapping}{NULL (default) or a list of aesthetic mappings to use for plot.} 25 | 26 | \item{spec.key}{string (defaults to "spec"), group variables names in \code{df}.} 27 | 28 | \item{env.key}{string (defaults to "env"), variables names in \code{df} that 29 | associated with the correlation coefficient matrix.} 30 | 31 | \item{curvature}{a numeric value giving the amount of curvature.} 32 | 33 | \item{spec.label.hspace, spec.label.vspace}{a numeric value giving the amount of 34 | horizontal/vertical space betweed group points and labels.} 35 | 36 | \item{on.left}{add link plot on left or right when the type of correlation plot 37 | is "full".} 38 | 39 | \item{diag.label}{logical (defaults to FALSE) to indicate whether add diag labels.} 40 | 41 | \item{extra.params}{other parameters that control details can be setting 42 | using the \code{extra_params} function.} 43 | 44 | \item{...}{extra params passing to \code{\link[ggplot2]{geom_curve}}.} 45 | } 46 | \description{ 47 | This function can add other associated information link plot more 48 | quickly, and this function can be used to reflect the relationship between 49 | other variables and variables in the correlation coefficient matrix plot. 50 | } 51 | \examples{ 52 | \dontrun{ 53 | require(vegan, quietly = TRUE) 54 | require(dplyr, quietly = TRUE) 55 | require(ggplot2, quietly = TRUE) 56 | data("varechem") 57 | data("varespec") 58 | mantel <- fortify_mantel(varespec, varechem, 59 | spec.select = list(1:10, 5:14, 7:22, 9:32)) 60 | quickcor(varechem, type = "upper") + 61 | geom_square() + 62 | add_link(mantel, diag.label = TRUE) + 63 | geom_diag_label() + remove_axis("x") 64 | 65 | mantel01 <- mantel \%>\% 66 | mutate(r = cut(r, breaks = c(-Inf, 0.25, 0.5, Inf), 67 | labels = c("<0.25", "0.25-0.5", ">=0.5"), 68 | right = FALSE), 69 | p.value = cut(p.value, breaks = c(-Inf, 0.001, 0.01, 0.05, Inf), 70 | labels = c("<0.001", "0.001-0.01", "0.01-0.05", ">=0.05"), 71 | right = FALSE)) 72 | quickcor(varechem, type = "upper") + geom_square() + 73 | add_link(mantel01, mapping = aes(colour = p.value, size = r), 74 | diag.label = TRUE) + 75 | geom_diag_label() + 76 | scale_size_manual(values = c(0.5, 1.5, 3)) + 77 | remove_axis("x") 78 | } 79 | } 80 | \author{ 81 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 82 | } 83 | -------------------------------------------------------------------------------- /man/as_cor_network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as-cor-network.R 3 | \name{as_cor_network} 4 | \alias{as_cor_network} 5 | \alias{as_cor_network.cor_tbl} 6 | \alias{as_cor_network.mantel_tbl} 7 | \alias{as_cor_network.matrix} 8 | \alias{as_cor_network.data.frame} 9 | \alias{as_cor_network.correlate} 10 | \alias{as_cor_network.rcorr} 11 | \alias{as_cor_network.corr.test} 12 | \alias{as_cor_network.igraph} 13 | \alias{as_cor_network.tbl_graph} 14 | \alias{as_cor_network.default} 15 | \title{Coerce to a cor_network object} 16 | \usage{ 17 | as_cor_network(x, ...) 18 | 19 | \method{as_cor_network}{cor_tbl}( 20 | x, 21 | directed = FALSE, 22 | simplify = TRUE, 23 | weight = NULL, 24 | r.thres = 0.6, 25 | r.absolute = TRUE, 26 | p.thres = 0.05, 27 | ... 28 | ) 29 | 30 | \method{as_cor_network}{mantel_tbl}(x, directed = FALSE, ...) 31 | 32 | \method{as_cor_network}{matrix}(x, directed = FALSE, ...) 33 | 34 | \method{as_cor_network}{data.frame}(x, directed = FALSE, ...) 35 | 36 | \method{as_cor_network}{correlate}(x, directed = FALSE, ...) 37 | 38 | \method{as_cor_network}{rcorr}(x, directed = FALSE, ...) 39 | 40 | \method{as_cor_network}{corr.test}(x, directed = FALSE, ...) 41 | 42 | \method{as_cor_network}{igraph}(x, ...) 43 | 44 | \method{as_cor_network}{tbl_graph}(x, ...) 45 | 46 | \method{as_cor_network}{default}(x, ...) 47 | } 48 | \arguments{ 49 | \item{x}{any \code{R} object.} 50 | 51 | \item{...}{extra params passing to \code{\link[ggcor]{cor_network}}.} 52 | 53 | \item{directed}{logical value, whether or not to create a directed graph.} 54 | 55 | \item{simplify}{logical value (defaults to TRUE) indicating whether to 56 | delete nodes without edge connections.} 57 | 58 | \item{weight}{NULL (default) or name of column in edges which will be renamed 59 | to "weight".} 60 | 61 | \item{r.thres}{a numeric value.} 62 | 63 | \item{r.absolute}{logical value (defaults to TRUE).} 64 | 65 | \item{p.thres}{a numeric value.} 66 | } 67 | \value{ 68 | a cor_network object. 69 | } 70 | \description{ 71 | Functions to coerce a object to cor_network if possible. 72 | } 73 | \examples{ 74 | ll <- correlate(mtcars) 75 | as_cor_network(ll) 76 | } 77 | \author{ 78 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 79 | } 80 | -------------------------------------------------------------------------------- /man/as_cor_tbl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as-cor-tbl.R 3 | \name{as_cor_tbl} 4 | \alias{as_cor_tbl} 5 | \alias{as_cor_tbl.matrix} 6 | \alias{as_cor_tbl.data.frame} 7 | \alias{as_cor_tbl.correlate} 8 | \alias{as_cor_tbl.rcorr} 9 | \alias{as_cor_tbl.corr.test} 10 | \alias{as_cor_tbl.mantel_tbl} 11 | \alias{as_cor_tbl.default} 12 | \title{Coerce to a cor_tbl object} 13 | \usage{ 14 | as_cor_tbl(x, ...) 15 | 16 | \method{as_cor_tbl}{matrix}(x, ...) 17 | 18 | \method{as_cor_tbl}{data.frame}(x, ...) 19 | 20 | \method{as_cor_tbl}{correlate}(x, extra.mat = list(), ...) 21 | 22 | \method{as_cor_tbl}{rcorr}(x, ...) 23 | 24 | \method{as_cor_tbl}{corr.test}(x, ...) 25 | 26 | \method{as_cor_tbl}{mantel_tbl}(x, byrow = TRUE, ...) 27 | 28 | \method{as_cor_tbl}{default}(x, ...) 29 | } 30 | \arguments{ 31 | \item{x}{any \code{R} object.} 32 | 33 | \item{...}{extra params passing to \code{\link[ggcor]{cor_tbl}}.} 34 | 35 | \item{extra.mat}{any other matrix-like data with same dimmsion as \code{x}.} 36 | 37 | \item{byrow}{a logical value indicating whether arrange the 'spec' columns on y axis.} 38 | } 39 | \value{ 40 | a cor_tbl object. 41 | } 42 | \description{ 43 | Functions to coerce a object to cor_tbl if possible. 44 | } 45 | \examples{ 46 | cor(mtcars) \%>\% as_cor_tbl() 47 | correlate(mtcars, cor.test = TRUE) \%>\% as_cor_tbl() 48 | correlate(mtcars, type = "upper") \%>\% as_cor_tbl() 49 | \dontrun{ 50 | ## S3 method for rcorr object 51 | require(Hmisc) 52 | rcorr(mtcars) \%>\% as_cor_tbl() 53 | 54 | ## S3 method for corr.test object 55 | require(psych) 56 | corr.test(mtcars) \%>\% as_cor_tbl() 57 | } 58 | } 59 | \author{ 60 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 61 | } 62 | -------------------------------------------------------------------------------- /man/as_igraph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as-igraph.R 3 | \name{as.igraph.cor_tbl} 4 | \alias{as.igraph.cor_tbl} 5 | \alias{as.igraph.mantel_tbl} 6 | \alias{as.igraph.rcorr} 7 | \alias{as.igraph.corr.test} 8 | \alias{as.igraph.correlate} 9 | \alias{as.igraph.cor_network} 10 | \title{Corece to a igraph object} 11 | \usage{ 12 | \method{as.igraph}{cor_tbl}(x, directed = FALSE, ...) 13 | 14 | \method{as.igraph}{mantel_tbl}(x, directed = FALSE, ...) 15 | 16 | \method{as.igraph}{rcorr}(x, directed = FALSE, ...) 17 | 18 | \method{as.igraph}{corr.test}(x, directed = FALSE, ...) 19 | 20 | \method{as.igraph}{correlate}(x, directed = FALSE, ...) 21 | 22 | \method{as.igraph}{cor_network}(x, directed = FALSE, ...) 23 | } 24 | \arguments{ 25 | \item{x}{\code{R} object.} 26 | 27 | \item{directed}{logical value, whether or not to create a directed graph.} 28 | 29 | \item{...}{extra params.} 30 | } 31 | \value{ 32 | igraph object. 33 | } 34 | \description{ 35 | Functions to coerce a object to igraph if possible. 36 | } 37 | \examples{ 38 | fortify_cor(mtcars) \%>\% as.igraph() 39 | correlate(mtcars, cor.test = TRUE) \%>\% as.igraph() 40 | } 41 | \author{ 42 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 43 | } 44 | -------------------------------------------------------------------------------- /man/as_matrix.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as-matrix.R 3 | \name{as_matrix} 4 | \alias{as_matrix} 5 | \alias{as_matrix.cor_tbl} 6 | \alias{as_matrix.mantel_tbl} 7 | \title{Convert a object to matrix} 8 | \usage{ 9 | as_matrix(x, ...) 10 | 11 | \method{as_matrix}{cor_tbl}(x, index = "all", missing = NULL, ...) 12 | 13 | \method{as_matrix}{mantel_tbl}(x, ...) 14 | } 15 | \arguments{ 16 | \item{x}{any \code{R} object.} 17 | 18 | \item{...}{extra params.} 19 | 20 | \item{index}{character vector indicating which columns will be convert. If "all", 21 | all columns will be convert.} 22 | 23 | \item{missing}{If NULL (default), the missing value will be filled with NAs.} 24 | } 25 | \value{ 26 | a list of matrix. 27 | } 28 | \description{ 29 | Functions to convert cor_tbl object to a list of matrix. 30 | } 31 | \examples{ 32 | cor(mtcars) \%>\% as_cor_tbl() \%>\% as_matrix() 33 | cor(mtcars) \%>\% as_cor_tbl() \%>\% as_matrix("r") 34 | fortify_cor(iris[-5],group = iris$Species, cor.test = TRUE) \%>\% 35 | as_matrix() 36 | } 37 | \author{ 38 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 39 | } 40 | -------------------------------------------------------------------------------- /man/as_tbl_graph.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as-tbl-graph.R 3 | \name{as_tbl_graph.cor_tbl} 4 | \alias{as_tbl_graph.cor_tbl} 5 | \alias{as_tbl_graph.mantel_tbl} 6 | \alias{as_tbl_graph.rcorr} 7 | \alias{as_tbl_graph.corr.test} 8 | \alias{as_tbl_graph.correlate} 9 | \alias{as_tbl_graph.cor_network} 10 | \title{Corece to a graph_tbl object} 11 | \usage{ 12 | \method{as_tbl_graph}{cor_tbl}(x, directed = FALSE, ...) 13 | 14 | \method{as_tbl_graph}{mantel_tbl}(x, directed = FALSE, ...) 15 | 16 | \method{as_tbl_graph}{rcorr}(x, directed = FALSE, ...) 17 | 18 | \method{as_tbl_graph}{corr.test}(x, directed = FALSE, ...) 19 | 20 | \method{as_tbl_graph}{correlate}(x, directed = FALSE, ...) 21 | 22 | \method{as_tbl_graph}{cor_network}(x, ...) 23 | } 24 | \arguments{ 25 | \item{x}{\code{R} object.} 26 | 27 | \item{directed}{logical value, whether or not to create a directed graph.} 28 | 29 | \item{...}{extra params.} 30 | } 31 | \value{ 32 | tbl_graph object. 33 | } 34 | \description{ 35 | Functions to coerce a object to graph_tbl if possible. 36 | } 37 | \author{ 38 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 39 | } 40 | -------------------------------------------------------------------------------- /man/colour-pal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/colour-pal-utils.R 3 | \name{brown_blue} 4 | \alias{brown_blue} 5 | \alias{pink_green} 6 | \alias{purple_green} 7 | \alias{brown_purple} 8 | \alias{red_blue} 9 | \alias{red_grey} 10 | \alias{red_yellow_blue} 11 | \alias{red_yellow_green} 12 | \alias{spectral} 13 | \alias{link_colour_pal} 14 | \title{Colour pal} 15 | \usage{ 16 | brown_blue(n = 11) 17 | 18 | pink_green(n = 11) 19 | 20 | purple_green(n = 11) 21 | 22 | brown_purple(n = 11) 23 | 24 | red_blue(n = 11) 25 | 26 | red_grey(n = 11) 27 | 28 | red_yellow_blue(n = 11) 29 | 30 | red_yellow_green(n = 11) 31 | 32 | spectral(n = 11) 33 | 34 | link_colour_pal(n) 35 | } 36 | \arguments{ 37 | \item{n}{number of different colors in the palette, minimum 3, maximum 11.} 38 | } 39 | \value{ 40 | a palette. 41 | } 42 | \description{ 43 | Wrapper for the diverging palettes provided by \code{\link{RColorBrewer}}. 44 | } 45 | -------------------------------------------------------------------------------- /man/cor-network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor-network.R 3 | \name{cor_network} 4 | \alias{cor_network} 5 | \alias{print.cor_network} 6 | \title{Tidy co-occurrence network data} 7 | \usage{ 8 | cor_network( 9 | corr, 10 | p.value = NULL, 11 | directed = FALSE, 12 | row.names = NULL, 13 | col.names = NULL, 14 | rm.dup = TRUE, 15 | simplify = TRUE, 16 | weight = NULL, 17 | r.thres = 0.6, 18 | r.absolute = TRUE, 19 | p.thres = 0.05, 20 | val.type = "tbl_graph" 21 | ) 22 | 23 | \method{print}{cor_network}(x, n = 3, ...) 24 | } 25 | \arguments{ 26 | \item{corr}{correlation matrix.} 27 | 28 | \item{p.value}{significant matrix of correlation.} 29 | 30 | \item{directed}{logical value, whether or not to create a directed graph.} 31 | 32 | \item{row.names, col.names}{row and column names of correlation matrix.} 33 | 34 | \item{rm.dup}{logical (defaults to TRUE) indicating whether remove duplicate 35 | rows. If TRUE, the correlation between A-B and B-A is retained only A-B.} 36 | 37 | \item{simplify}{logical value (defaults to TRUE) indicating whether to 38 | delete nodes without edge connections.} 39 | 40 | \item{weight}{NULL (default) or name of column in edges which will be renamed 41 | to "weight".} 42 | 43 | \item{r.thres}{a numeric value.} 44 | 45 | \item{r.absolute}{logical value (defaults to TRUE).} 46 | 47 | \item{p.thres}{a numeric value.} 48 | 49 | \item{val.type}{type return value: 50 | \itemize{ 51 | \item \code{tbl_graph}: return tbl_graph object 52 | \item \code{igraph}: return igraph object 53 | \item \code{list}: return a list of nodes and edges 54 | }} 55 | 56 | \item{x}{a cor_network object.} 57 | 58 | \item{n}{number of rows to show.} 59 | 60 | \item{...}{extra params for printing.} 61 | } 62 | \value{ 63 | a tbl_graph (default), igraph or list object. 64 | } 65 | \description{ 66 | The function calculates correlation coefficient, statistical 67 | significance level and filters according to conditions. 68 | } 69 | \examples{ 70 | cor_network(cor(mtcars)) 71 | corr <- correlate(mtcars, cor.test = TRUE) 72 | cor_network(corr$r, corr$p.value) 73 | 74 | ## return a igraph object 75 | cor_network(corr$r, corr$p.value, val.type = "igraph") 76 | 77 | ## reurn a tbl_graph object 78 | cor_network(corr$r, corr$p.value, val.type = "tbl_graph") 79 | 80 | } 81 | \author{ 82 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 83 | } 84 | -------------------------------------------------------------------------------- /man/cor_tbl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor-tbl.R 3 | \name{cor_tbl} 4 | \alias{cor_tbl} 5 | \title{Create a cor_tbl object} 6 | \usage{ 7 | cor_tbl( 8 | corr, 9 | p.value = NULL, 10 | extra.mat = list(), 11 | type = "full", 12 | show.diag = TRUE, 13 | row.names = NULL, 14 | col.names = NULL, 15 | cluster = FALSE, 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{corr}{correlation matrix.} 21 | 22 | \item{p.value}{significance value matrix of correaltion.} 23 | 24 | \item{extra.mat}{any other matrix-like data with same dimmsion as \code{x}.} 25 | 26 | \item{type}{a string, "full" (default), "upper" or "lower", display full, 27 | lower triangular or upper triangular matrix.} 28 | 29 | \item{show.diag}{a logical value indicating whether keep the diagonal.} 30 | 31 | \item{row.names, col.names}{row/column names of correlation matrix.} 32 | 33 | \item{cluster}{a logical value indicating whether reorder the correlation matrix 34 | by clustering, default is FALSE.} 35 | 36 | \item{...}{extra params passing to \code{\link[ggcor]{cor_tbl}}.} 37 | } 38 | \value{ 39 | a cor_tbl object. 40 | } 41 | \description{ 42 | Functions to create cor_tbl object from correlation matrix. 43 | } 44 | \details{ 45 | \code{cluster = TRUE} just supports for symmetric correlation matrix. 46 | } 47 | \examples{ 48 | cor_tbl(cor(mtcars)) 49 | corr <- correlate(mtcars, cor.test = TRUE) 50 | 51 | ## with p value 52 | cor_tbl(corr$r, corr$p.value) 53 | 54 | ## reorder correlation matrix 55 | cor_tbl(corr$r, corr$p.value, cluster = TRUE) 56 | 57 | ## exclude upper or lower 58 | ### exclude lower 59 | cor_tbl(corr$r, corr$p.value, type = "upper") 60 | ### exclude upper 61 | cor_tbl(corr$r, corr$p.value, type = "lower", show.diag = FALSE) 62 | 63 | ## add extra matrix data 64 | m <- matrix(rnorm(11*11), nrow = 11) 65 | cor_tbl(corr$r, corr$p.value, extra.mat = list(m = m)) 66 | } 67 | \author{ 68 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 69 | } 70 | -------------------------------------------------------------------------------- /man/corrlate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor-test.R 3 | \name{correlate} 4 | \alias{correlate} 5 | \alias{fast_correlate} 6 | \alias{fast_correlate2} 7 | \title{Matrix of Correlations, P-values and confidence intervals} 8 | \usage{ 9 | correlate( 10 | x, 11 | y = NULL, 12 | cor.test = FALSE, 13 | method = "pearson", 14 | use = "everything", 15 | ... 16 | ) 17 | 18 | fast_correlate(x, y = NULL, use = "everything", ...) 19 | 20 | fast_correlate2(x, method = "pearson", ...) 21 | } 22 | \arguments{ 23 | \item{x, y}{a matrix object or NULL.} 24 | 25 | \item{cor.test}{logical, if \code{TRUE} (default) will test for correlation.} 26 | 27 | \item{method}{a character string indicating which correlation coefficient is to be used 28 | for the test. One of "pearson", "kendall", or "spearman".} 29 | 30 | \item{use}{an optional character string giving a method for computing covariances in the presence of missing values.} 31 | 32 | \item{...}{extra params, see Details.} 33 | } 34 | \value{ 35 | a list with correlation matrix, P values matrix, confidence intervals matrix. 36 | } 37 | \description{ 38 | \code{correlate} uses \code{cor} to find the correlations and use \code{cor.test} to find 39 | the p values, confidence intervals for all possible pairs of columns ofmatrix. 40 | } 41 | \details{ 42 | The columns of 'x' will be tested for each pair when y is NULL(the default), 43 | otherwise each column in 'x' and each column in 'y' is tested for each pair. 44 | } 45 | \examples{ 46 | correlate(mtcars) 47 | m1 <- matrix(rnorm(100), nrow = 10) 48 | m2 <- matrix(rnorm(60), nrow = 10) 49 | 50 | ## not test for correlation matrix 51 | correlate(m1, m2) 52 | 53 | ## test for correlation matrix 54 | correlate(m1, m2, cor.test = TRUE) 55 | 56 | ## fast compute correlation 57 | \dontrun{ 58 | require(WGCNA) 59 | fast_correlate(m1, m2) 60 | 61 | require(picante) 62 | fast_correlate2(m1) 63 | } 64 | } 65 | \seealso{ 66 | \code{\link[stats]{cor}}, \code{\link[stats]{cor.test}}. 67 | } 68 | \author{ 69 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 70 | } 71 | -------------------------------------------------------------------------------- /man/create-layout.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/create-layout.R 3 | \name{parallel_layout} 4 | \alias{parallel_layout} 5 | \alias{combination_layout} 6 | \title{Transform data base on different layout} 7 | \usage{ 8 | parallel_layout( 9 | data, 10 | start.var = NULL, 11 | end.var = NULL, 12 | horiz = FALSE, 13 | stretch = TRUE, 14 | sort.start = NULL, 15 | sort.end = NULL, 16 | start.x = NULL, 17 | start.y = NULL, 18 | end.x = NULL, 19 | end.y = NULL 20 | ) 21 | 22 | combination_layout( 23 | data, 24 | type = NULL, 25 | show.diag = NULL, 26 | row.names = NULL, 27 | col.names = NULL, 28 | start.var = NULL, 29 | end.var = NULL, 30 | cor_tbl 31 | ) 32 | } 33 | \arguments{ 34 | \item{data}{a data frame.} 35 | 36 | \item{start.var, end.var}{character to specify which variable is the starting 37 | points and which is the ending points. if the variable is not character, it 38 | is forced to be converted.} 39 | 40 | \item{horiz}{a logical value. If FALSE, the parallel graph are drawn vertically. 41 | If TRUE, the parallel graph are drawn horizontally.} 42 | 43 | \item{stretch}{logical, indicating whether the heights/width of start points and 44 | end points are consistent.} 45 | 46 | \item{sort.start, sort.end}{charater vector, the nodes will be sorted by this parameter.} 47 | 48 | \item{start.x, start.y, end.x, end.y}{numeric to specify the x (horiz = TRUE) or y 49 | (horiz = FALSE) coordinates.} 50 | 51 | \item{type}{the type (""upper" or "lower") of the correlation matrix plot.} 52 | 53 | \item{show.diag}{a logical value indicating whether keep the diagonal.} 54 | 55 | \item{row.names, col.names}{row/column names of correlation matrix.} 56 | 57 | \item{cor_tbl}{a col_tbl object.} 58 | } 59 | \value{ 60 | a data frame. 61 | } 62 | \description{ 63 | These layout functions are not layout in the network diagram, 64 | it just converts the original data into a form that makes it easy to draw 65 | a curve graph. 66 | } 67 | \examples{ 68 | cor_tbl(cor(mtcars)) \%>\% 69 | parallel_layout() 70 | \dontrun{ 71 | data("varespec", package = "vegan") 72 | data("varechem", package = "vegan") 73 | mantel_test(varespec, varechem) \%>\% 74 | combination_layout(type = "upper", col.names = colnames(varechem), 75 | show.diag = FALSE) 76 | } 77 | } 78 | \author{ 79 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 80 | } 81 | -------------------------------------------------------------------------------- /man/display_cor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/display-cor.R 3 | \name{display_cor} 4 | \alias{display_cor} 5 | \alias{display_cor.matrix} 6 | \alias{display_cor.data.frame} 7 | \alias{display_cor.correlate} 8 | \alias{display_cor.rcorr} 9 | \alias{display_cor.corr.test} 10 | \alias{display_cor.cor_tbl} 11 | \alias{display_cor.mantel_tbl} 12 | \alias{format_cor} 13 | \title{Display correlation matrix with nice format} 14 | \usage{ 15 | display_cor(x, ...) 16 | 17 | \method{display_cor}{matrix}(x, ...) 18 | 19 | \method{display_cor}{data.frame}(x, ...) 20 | 21 | \method{display_cor}{correlate}(x, ...) 22 | 23 | \method{display_cor}{rcorr}(x, ...) 24 | 25 | \method{display_cor}{corr.test}(x, ...) 26 | 27 | \method{display_cor}{cor_tbl}( 28 | x, 29 | type = "full", 30 | show.diag = FALSE, 31 | digits = 2, 32 | nsmall = 2, 33 | sig.level = c(0.05, 0.01, 0.001), 34 | mark = c("*", "**", "***"), 35 | coef = NULL, 36 | nice.format = TRUE, 37 | ... 38 | ) 39 | 40 | \method{display_cor}{mantel_tbl}(x, byrow = TRUE, ...) 41 | 42 | format_cor( 43 | corr, 44 | p.value = NULL, 45 | type = "full", 46 | show.diag = FALSE, 47 | digits = 2, 48 | nsmall = 2, 49 | sig.level = c(0.05, 0.01, 0.001), 50 | mark = c("*", "**", "***"), 51 | nice.format = TRUE 52 | ) 53 | } 54 | \arguments{ 55 | \item{x}{any \code{R} object.} 56 | 57 | \item{...}{extra params passing to \code{\link[ggcor]{format_cor}}.} 58 | 59 | \item{type}{a string, "full" (default), "upper" or "lower", display full, 60 | lower triangular or upper triangular matrix.} 61 | 62 | \item{show.diag}{a logical value indicating whether keep the diagonal.} 63 | 64 | \item{digits}{integer indicating the number of decimal places (round) or 65 | significant digits (signif) to be used, the default value is 2.} 66 | 67 | \item{nsmall}{the minimum number of digits to the right of the decimal 68 | point in formatting real/complex numbers in non-scientific formats, 69 | the default value is 2.} 70 | 71 | \item{sig.level}{significance level，the defaults values is [0.05, 0.01, 0.001].} 72 | 73 | \item{mark}{significance mark，the defaults values is ["*", "**", "***"].} 74 | 75 | \item{coef}{string to specifies which column is the coefficient when "x" 76 | is a general_cor_tbl.} 77 | 78 | \item{nice.format}{a logical value indicating whether the output needs to be 79 | automatically optimized.} 80 | 81 | \item{byrow}{a logical value indicating whether arrange the 'spec' columns on y axis.} 82 | 83 | \item{corr}{a correlation matrix.} 84 | 85 | \item{p.value}{NULL (default) or a matrix of p value.} 86 | } 87 | \value{ 88 | a data frame. 89 | } 90 | \description{ 91 | Functions to display correlation object. 92 | 93 | Format an correlation matrix for printing. 94 | } 95 | \examples{ 96 | corr <- correlate(mtcars, cor.test = TRUE) 97 | format_cor(corr$r, corr$p.value, type = "lower") 98 | display_cor(corr) 99 | } 100 | \author{ 101 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 102 | } 103 | -------------------------------------------------------------------------------- /man/expand_axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/expand-axis.R 3 | \name{expand_axis} 4 | \alias{expand_axis} 5 | \title{Expand axis limits} 6 | \usage{ 7 | expand_axis(x = NULL, y = NULL) 8 | } 9 | \arguments{ 10 | \item{x, y}{NULL (default) or numeric vector.} 11 | } 12 | \description{ 13 | Force to extend the coordinate range of the ggplot object. 14 | } 15 | \examples{ 16 | quickcor(mtcars) + geom_square() + expand_axis(x = -3) 17 | quickcor(mtcars) + geom_square() + expand_axis(y = 16) 18 | } 19 | \author{ 20 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 21 | } 22 | -------------------------------------------------------------------------------- /man/export_cor_network.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/export-cor-network.R 3 | \name{export_cor_network} 4 | \alias{export_cor_network} 5 | \alias{export_cor_network.cor_network} 6 | \alias{export_cor_network.cor_tbl} 7 | \alias{export_cor_network.mantel_tbl} 8 | \alias{export_cor_network.matrix} 9 | \alias{export_cor_network.data.frame} 10 | \alias{export_cor_network.correlate} 11 | \alias{export_cor_network.rcorr} 12 | \alias{export_cor_network.corr.test} 13 | \title{Output co-network object} 14 | \usage{ 15 | export_cor_network(x, file = "", what = "edges", sep = ",", ...) 16 | 17 | \method{export_cor_network}{cor_network}(x, file = "", what = "edges", sep = ",", ...) 18 | 19 | \method{export_cor_network}{cor_tbl}( 20 | x, 21 | file = "", 22 | what = "edges", 23 | sep = ",", 24 | simplify = TRUE, 25 | r.thres = 0.6, 26 | r.absolute = TRUE, 27 | p.thres = 0.05, 28 | ... 29 | ) 30 | 31 | \method{export_cor_network}{mantel_tbl}( 32 | x, 33 | file = "", 34 | what = "edges", 35 | sep = ",", 36 | simplify = TRUE, 37 | r.thres = 0.6, 38 | r.absolute = TRUE, 39 | p.thres = 0.05, 40 | ... 41 | ) 42 | 43 | \method{export_cor_network}{matrix}( 44 | x, 45 | file = "", 46 | what = "edges", 47 | sep = ",", 48 | row.names = NULL, 49 | col.names = NULL, 50 | rm.dup = TRUE, 51 | simplify = TRUE, 52 | r.thres = 0.6, 53 | r.absolute = TRUE, 54 | ... 55 | ) 56 | 57 | \method{export_cor_network}{data.frame}( 58 | x, 59 | file = "", 60 | what = "edges", 61 | sep = ",", 62 | row.names = NULL, 63 | col.names = NULL, 64 | rm.dup = TRUE, 65 | simplify = TRUE, 66 | r.thres = 0.6, 67 | r.absolute = TRUE, 68 | ... 69 | ) 70 | 71 | \method{export_cor_network}{correlate}( 72 | x, 73 | file = "", 74 | what = "edges", 75 | sep = ",", 76 | row.names = NULL, 77 | col.names = NULL, 78 | rm.dup = TRUE, 79 | simplify = TRUE, 80 | r.thres = 0.6, 81 | r.absolute = TRUE, 82 | p.thres = 0.05, 83 | ... 84 | ) 85 | 86 | \method{export_cor_network}{rcorr}( 87 | x, 88 | file = "", 89 | what = "edges", 90 | sep = ",", 91 | row.names = NULL, 92 | col.names = NULL, 93 | rm.dup = TRUE, 94 | simplify = TRUE, 95 | r.thres = 0.6, 96 | r.absolute = TRUE, 97 | p.thres = 0.05, 98 | ... 99 | ) 100 | 101 | \method{export_cor_network}{corr.test}( 102 | x, 103 | file = "", 104 | what = "edges", 105 | sep = ",", 106 | row.names = NULL, 107 | col.names = NULL, 108 | rm.dup = TRUE, 109 | simplify = TRUE, 110 | r.thres = 0.6, 111 | r.absolute = TRUE, 112 | p.thres = 0.05, 113 | ... 114 | ) 115 | } 116 | \arguments{ 117 | \item{x}{\code{R} object can be convert to \code{cor_network}.} 118 | 119 | \item{file}{a character string naming a file for writing. "" indicates 120 | output to the console.} 121 | 122 | \item{what}{either "edges" (default) or "nodes" will be output.} 123 | 124 | \item{sep}{the field separator string (defaults to ",").} 125 | 126 | \item{...}{extra params passing to \code{\link[utils]{write.table}}.} 127 | 128 | \item{simplify}{logical value (defaults to TRUE) indicating whether to 129 | delete nodes without edge connections.} 130 | 131 | \item{r.thres}{a numeric value.} 132 | 133 | \item{r.absolute}{logical value (defaults to TRUE).} 134 | 135 | \item{p.thres}{a numeric value.} 136 | 137 | \item{row.names, col.names}{row and column names of correlation matrix.} 138 | 139 | \item{rm.dup}{logical (defaults to TRUE) indicating whether remove duplicate 140 | rows. If TRUE, the correlation between A-B and B-A is retained only A-B.} 141 | } 142 | \description{ 143 | Functions to output edges or nodes data of co-network 144 | to a file. 145 | } 146 | \seealso{ 147 | \code{\link[utils]{write.table}}. 148 | } 149 | \author{ 150 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 151 | } 152 | -------------------------------------------------------------------------------- /man/extra_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-link-extra-params.R 3 | \name{extra_params} 4 | \alias{extra_params} 5 | \title{Extra params for add_link} 6 | \usage{ 7 | extra_params( 8 | spec.label = text_params(), 9 | spec.point = point_params(fill = "blue"), 10 | env.point = point_params(fill = "grey60"), 11 | link.params = link_params() 12 | ) 13 | } 14 | \arguments{ 15 | \item{spec.label}{NULL or "text_params" object producing by 16 | \code{\link[ggcor]{text_params}}.} 17 | 18 | \item{spec.point}{NULL or "point_params" object producing by 19 | \code{\link[ggcor]{point_params}}.} 20 | 21 | \item{env.point}{NULL or "point_params" object producing by 22 | \code{\link[ggcor]{point_params}}.} 23 | 24 | \item{link.params}{"point_params" object producing by \code{\link[ggcor]{point_params}}.} 25 | } 26 | \description{ 27 | This function is used to control the details 28 | of the link, including the location, shape, size, color 29 | of points, and font size, font color, and so on of the 30 | text label. 31 | } 32 | \author{ 33 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 34 | } 35 | -------------------------------------------------------------------------------- /man/extract_cor_tbl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get-data.R 3 | \name{get_lower_data} 4 | \alias{get_lower_data} 5 | \alias{get_upper_data} 6 | \alias{get_diag_tri} 7 | \alias{get_diag_data} 8 | \alias{is_symmet} 9 | \title{Helper function to extract cor_tbl.} 10 | \usage{ 11 | get_lower_data(x, show.diag = TRUE) 12 | 13 | get_upper_data(x, show.diag = TRUE) 14 | 15 | get_diag_tri(x) 16 | 17 | get_diag_data(x) 18 | 19 | is_symmet(x) 20 | } 21 | \arguments{ 22 | \item{x}{a cor_tbl object.} 23 | 24 | \item{show.diag}{a logical value indicating whether keep the diagonal.} 25 | } 26 | \value{ 27 | a modified cor_tbl object. 28 | } 29 | \description{ 30 | These functions are used to quickly obtain the upper 31 | trig, lower trig, diagonal, or remove the diagonal of the correlation 32 | coefficient matrix. 33 | } 34 | \examples{ 35 | df <- fortify_cor(mtcars) 36 | quickcor(df) + geom_colour() 37 | 38 | ## exclude upper 39 | df \%>\% get_lower_data() \%>\% 40 | quickcor() + geom_colour() 41 | 42 | ## exclude lower 43 | df \%>\% get_upper_data(show.diag = FALSE) \%>\% 44 | quickcor() + geom_colour() 45 | 46 | ## get the diagonal 47 | df \%>\% get_diag_data() \%>\% 48 | quickcor() + geom_colour() 49 | 50 | ## exclude the diagonal 51 | df \%>\% get_diag_tri() \%>\% 52 | quickcor() + geom_colour() 53 | } 54 | \author{ 55 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 56 | } 57 | -------------------------------------------------------------------------------- /man/figures/README-example01-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-example01-1.png -------------------------------------------------------------------------------- /man/figures/README-example01-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-example01-2.png -------------------------------------------------------------------------------- /man/figures/README-example01-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-example01-3.png -------------------------------------------------------------------------------- /man/figures/README-example02-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-example02-1.png -------------------------------------------------------------------------------- /man/figures/README-example03-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-example03-1.png -------------------------------------------------------------------------------- /man/figures/README-example03-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-example03-2.png -------------------------------------------------------------------------------- /man/figures/README-pressure-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-pressure-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-2-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-unnamed-chunk-2-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-3-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-unnamed-chunk-3-1.png -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hannet91/ggcor/2e3f892919bf3c73f0d271df51708cc204a2d070/man/figures/README-unnamed-chunk-4-1.png -------------------------------------------------------------------------------- /man/fortify_cor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fortify-cor.R 3 | \name{fortify_cor} 4 | \alias{fortify_cor} 5 | \title{Convert to cor_tbl based on input type.convert} 6 | \usage{ 7 | fortify_cor( 8 | x, 9 | y = NULL, 10 | is.cor = FALSE, 11 | group = NULL, 12 | type = "full", 13 | show.diag = FALSE, 14 | cor.test = FALSE, 15 | cluster = FALSE, 16 | cluster.method = "complete", 17 | k = 2, 18 | ... 19 | ) 20 | } 21 | \arguments{ 22 | \item{x}{any \code{R} object.} 23 | 24 | \item{y}{NULL (default) or a matrix or data frame with compatible 25 | dimensions to x.} 26 | 27 | \item{is.cor}{logical value (default to FALSE) indicating wheater 28 | \code{x} is a correlation matrix.} 29 | 30 | \item{group}{NULL (default) or a vector that has the same number 31 | of rows as x.} 32 | 33 | \item{type}{a string, "full" (default), "upper" or "lower", display full, 34 | lower triangular or upper triangular matrix.} 35 | 36 | \item{show.diag}{a logical value indicating whether keep the diagonal.} 37 | 38 | \item{cor.test}{logical value (default is FALSE) indicating whether test 39 | for the correlation.} 40 | 41 | \item{cluster}{logical value (default is FALSE) indicating whether reorder 42 | the correlation matrix by cluster.} 43 | 44 | \item{cluster.method}{the agglomeration method to be used. This should be 45 | (an unambiguous abbreviation of) one of "ward.D", "ward.D2", "single", 46 | "complete", "average" (= UPGMA), "mcquitty" (= WPGMA), "median" (= WPGMC) 47 | or "centroid" (= UPGMC).} 48 | 49 | \item{k}{integer, the number of cluster group.} 50 | 51 | \item{...}{extra params passing to \code{matrix_order}.} 52 | } 53 | \value{ 54 | cor_tbl object. 55 | } 56 | \description{ 57 | The fortify_cor function is a deep encapsulation of 58 | the \code{as_cor_tbl} function and also supports converting raw 59 | data into cor_tbl objects by calculation. 60 | } 61 | \examples{ 62 | fortify_cor(mtcars) 63 | fortify_cor(iris[-5], group = iris[[5]]) 64 | fortify_cor(mtcars, type = "lower", cluster = TRUE) 65 | m <- cor(mtcars) 66 | fortify_cor(m, is.cor = TRUE) 67 | } 68 | \seealso{ 69 | \code{\link[ggcor]{matrix_order}}, \code{\link[stats]{hclust}}, 70 | \code{\link[ggcor]{as_cor_tbl}}. 71 | } 72 | \author{ 73 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 74 | } 75 | -------------------------------------------------------------------------------- /man/fortify_mantel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fortify-mantel.R 3 | \name{fortify_mantel} 4 | \alias{fortify_mantel} 5 | \title{Tidy for mantel tests} 6 | \usage{ 7 | fortify_mantel( 8 | spec, 9 | env, 10 | group = NULL, 11 | env.ctrl = NULL, 12 | mantel.fun = "mantel", 13 | ... 14 | ) 15 | } 16 | \arguments{ 17 | \item{spec, env}{data frame object.} 18 | 19 | \item{group}{vector for rows grouping.} 20 | 21 | \item{env.ctrl}{NULL (default), data frame or named list of data frame.} 22 | 23 | \item{mantel.fun}{string, function of mantel test.} 24 | 25 | \item{...}{extra params for \code{\link[ggcor]{mantel_test}}.} 26 | } 27 | \description{ 28 | Enhanced encapsulation of the mantel_test function. 29 | } 30 | \examples{ 31 | library(vegan) 32 | data("varespec") 33 | data("varechem") 34 | fortify_mantel(varespec, varechem, 35 | spec.select = list(spec01 = 1:5, spec02 = 6:12)) 36 | fortify_mantel(varespec, varechem, 37 | spec.select = list(spec01 = 1:5, spec02 = 6:12), 38 | env.select = list(env01 = 1:5, env02 = 6:10, env03 = 11:14)) 39 | set.seed(20191224) 40 | sam_grp <- sample(paste0("sample", 1:3), 24, replace = TRUE) 41 | fortify_mantel(varespec, varechem, group = sam_grp) 42 | } 43 | \seealso{ 44 | \code{\link[ggcor]{mantel_test}}. 45 | } 46 | \author{ 47 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 48 | } 49 | -------------------------------------------------------------------------------- /man/geom_circle2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-circle2.R 3 | \docType{data} 4 | \name{geom_circle2} 5 | \alias{geom_circle2} 6 | \alias{geom_upper_circle2} 7 | \alias{geom_lower_circle2} 8 | \alias{GeomCircle2} 9 | \alias{GeomUpperCircle2} 10 | \alias{GeomLowerCircle2} 11 | \title{Circle Geom} 12 | \usage{ 13 | geom_circle2( 14 | mapping = NULL, 15 | data = NULL, 16 | stat = "identity", 17 | position = "identity", 18 | ..., 19 | n = 60, 20 | na.rm = FALSE, 21 | show.legend = NA, 22 | inherit.aes = TRUE 23 | ) 24 | 25 | geom_upper_circle2( 26 | mapping = NULL, 27 | data = get_data(type = "upper"), 28 | stat = "identity", 29 | position = "identity", 30 | ..., 31 | na.rm = FALSE, 32 | show.legend = NA, 33 | inherit.aes = TRUE 34 | ) 35 | 36 | geom_lower_circle2( 37 | mapping = NULL, 38 | data = get_data(type = "lower"), 39 | stat = "identity", 40 | position = "identity", 41 | ..., 42 | na.rm = FALSE, 43 | show.legend = NA, 44 | inherit.aes = TRUE 45 | ) 46 | } 47 | \arguments{ 48 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 49 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 50 | default), it is combined with the default mapping at the top level of the 51 | plot. You must supply \code{mapping} if there is no plot mapping.} 52 | 53 | \item{data}{The data to be displayed in this layer. There are three 54 | options: 55 | 56 | If \code{NULL}, the default, the data is inherited from the plot 57 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 58 | 59 | A \code{data.frame}, or other object, will override the plot 60 | data. All objects will be fortified to produce a data frame. See 61 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 62 | 63 | A \code{function} will be called with a single argument, 64 | the plot data. The return value must be a \code{data.frame}, and 65 | will be used as the layer data. A \code{function} can be created 66 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 67 | 68 | \item{stat}{The statistical transformation to use on the data for this 69 | layer, as a string.} 70 | 71 | \item{position}{Position adjustment, either as a string, or the result of 72 | a call to a position adjustment function.} 73 | 74 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 75 | often aesthetics, used to set an aesthetic to a fixed value, like 76 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 77 | to the paired geom/stat.} 78 | 79 | \item{n}{the number of circle path points.} 80 | 81 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 82 | a warning. If \code{TRUE}, missing values are silently removed.} 83 | 84 | \item{show.legend}{logical. Should this layer be included in the legends? 85 | \code{NA}, the default, includes if any aesthetics are mapped. 86 | \code{FALSE} never includes, and \code{TRUE} always includes. 87 | It can also be a named logical vector to finely select the aesthetics to 88 | display.} 89 | 90 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 91 | rather than combining with them. This is most useful for helper functions 92 | that define both data and aesthetics and shouldn't inherit behaviour from 93 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 94 | } 95 | \description{ 96 | Circle Geom 97 | } 98 | \section{Aesthetics}{ 99 | 100 | \code{geom_circle2()}, \code{geom_upper_circle2()} and \code{geom_lower_circle2()} 101 | understands the following aesthetics (required aesthetics are in bold): 102 | \itemize{ 103 | \item \strong{\code{x}} 104 | \item \strong{\code{y}} 105 | \item \code{r0} 106 | \item \code{alpha} 107 | \item \code{colour} 108 | \item \code{fill} 109 | \item \code{linetype} 110 | \item \code{size} 111 | \item \code{upper_r0} 112 | \item \code{upper_alpha} 113 | \item \code{upper_colour} 114 | \item \code{upper_fill} 115 | \item \code{upper_linetype} 116 | \item \code{upper_size} 117 | \item \code{lower_r0} 118 | \item \code{lower_alpha} 119 | \item \code{lower_colour} 120 | \item \code{lower_fill} 121 | \item \code{lower_linetype} 122 | \item \code{lower_size} 123 | } 124 | } 125 | 126 | \author{ 127 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 128 | } 129 | \keyword{datasets} 130 | -------------------------------------------------------------------------------- /man/geom_confbox.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-conf.R 3 | \docType{data} 4 | \name{geom_confbox} 5 | \alias{geom_confbox} 6 | \alias{GeomConfbox} 7 | \title{Confident-Box Geom} 8 | \usage{ 9 | geom_confbox( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | ..., 15 | width = 0.5, 16 | na.rm = FALSE, 17 | show.legend = NA, 18 | inherit.aes = TRUE 19 | ) 20 | } 21 | \arguments{ 22 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 23 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 24 | default), it is combined with the default mapping at the top level of the 25 | plot. You must supply \code{mapping} if there is no plot mapping.} 26 | 27 | \item{data}{The data to be displayed in this layer. There are three 28 | options: 29 | 30 | If \code{NULL}, the default, the data is inherited from the plot 31 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 32 | 33 | A \code{data.frame}, or other object, will override the plot 34 | data. All objects will be fortified to produce a data frame. See 35 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 36 | 37 | A \code{function} will be called with a single argument, 38 | the plot data. The return value must be a \code{data.frame}, and 39 | will be used as the layer data. A \code{function} can be created 40 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 41 | 42 | \item{stat}{The statistical transformation to use on the data for this 43 | layer, as a string.} 44 | 45 | \item{position}{Position adjustment, either as a string, or the result of 46 | a call to a position adjustment function.} 47 | 48 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 49 | often aesthetics, used to set an aesthetic to a fixed value, like 50 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 51 | to the paired geom/stat.} 52 | 53 | \item{width}{the width of confident box.} 54 | 55 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 56 | a warning. If \code{TRUE}, missing values are silently removed.} 57 | 58 | \item{show.legend}{logical. Should this layer be included in the legends? 59 | \code{NA}, the default, includes if any aesthetics are mapped. 60 | \code{FALSE} never includes, and \code{TRUE} always includes. 61 | It can also be a named logical vector to finely select the aesthetics to 62 | display.} 63 | 64 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 65 | rather than combining with them. This is most useful for helper functions 66 | that define both data and aesthetics and shouldn't inherit behaviour from 67 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 68 | } 69 | \description{ 70 | Confident-Box Geom 71 | } 72 | \section{Aesthetics}{ 73 | 74 | \code{geom_confbox()} understands the following aesthetics (required 75 | aesthetics are in bold): 76 | \itemize{ 77 | \item \strong{\code{x}} 78 | \item \strong{\code{y}} 79 | \item \strong{\code{r}} 80 | \item \strong{\code{lower.ci}} 81 | \item \strong{\code{upper.ci}} 82 | \item \code{alpha} 83 | \item \code{colour} 84 | \item \code{confline.col} 85 | \item \code{midline.col} 86 | \item \code{fill} 87 | \item \code{linetype} 88 | \item \code{size} 89 | } 90 | } 91 | 92 | \author{ 93 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 94 | } 95 | \keyword{datasets} 96 | -------------------------------------------------------------------------------- /man/geom_cross.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-cross.R 3 | \docType{data} 4 | \name{geom_cross} 5 | \alias{geom_cross} 6 | \alias{GeomCross} 7 | \title{Cross Geom} 8 | \usage{ 9 | geom_cross( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | ..., 15 | sig.level = 0.05, 16 | linejoin = "mitre", 17 | na.rm = FALSE, 18 | show.legend = NA, 19 | inherit.aes = TRUE 20 | ) 21 | } 22 | \arguments{ 23 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 24 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 25 | default), it is combined with the default mapping at the top level of the 26 | plot. You must supply \code{mapping} if there is no plot mapping.} 27 | 28 | \item{data}{The data to be displayed in this layer. There are three 29 | options: 30 | 31 | If \code{NULL}, the default, the data is inherited from the plot 32 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 33 | 34 | A \code{data.frame}, or other object, will override the plot 35 | data. All objects will be fortified to produce a data frame. See 36 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 37 | 38 | A \code{function} will be called with a single argument, 39 | the plot data. The return value must be a \code{data.frame}, and 40 | will be used as the layer data. A \code{function} can be created 41 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 42 | 43 | \item{stat}{The statistical transformation to use on the data for this 44 | layer, as a string.} 45 | 46 | \item{position}{Position adjustment, either as a string, or the result of 47 | a call to a position adjustment function.} 48 | 49 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 50 | often aesthetics, used to set an aesthetic to a fixed value, like 51 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 52 | to the paired geom/stat.} 53 | 54 | \item{sig.level}{significance threshold.} 55 | 56 | \item{linejoin}{Line join style (round, mitre, bevel).} 57 | 58 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 59 | a warning. If \code{TRUE}, missing values are silently removed.} 60 | 61 | \item{show.legend}{logical. Should this layer be included in the legends? 62 | \code{NA}, the default, includes if any aesthetics are mapped. 63 | \code{FALSE} never includes, and \code{TRUE} always includes. 64 | It can also be a named logical vector to finely select the aesthetics to 65 | display.} 66 | 67 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 68 | rather than combining with them. This is most useful for helper functions 69 | that define both data and aesthetics and shouldn't inherit behaviour from 70 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 71 | } 72 | \description{ 73 | Cross Geom 74 | } 75 | \section{Aesthetics}{ 76 | 77 | \code{geom_cross()} understands the following aesthetics (required 78 | aesthetics are in bold): 79 | \itemize{ 80 | \item \strong{\code{x}} 81 | \item \strong{\code{y}} 82 | \item \strong{\code{p.value}} 83 | \item \code{alpha} 84 | \item \code{colour} 85 | \item \code{linetype} 86 | \item \code{size} 87 | } 88 | } 89 | 90 | \author{ 91 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 92 | } 93 | \keyword{datasets} 94 | -------------------------------------------------------------------------------- /man/geom_diag_label.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-diag-label.R 3 | \name{geom_diag_label} 4 | \alias{geom_diag_label} 5 | \alias{add_diag_label} 6 | \title{Add diagnoal labels on correlation plot} 7 | \usage{ 8 | geom_diag_label(mapping = NULL, data = NULL, drop = FALSE, ...) 9 | } 10 | \arguments{ 11 | \item{mapping}{aesthetic mappings parameters.} 12 | 13 | \item{data}{NULL (default) or a cor_tbl object.} 14 | 15 | \item{drop}{logical value (default is TRUE). When type of plot is 'upper' 16 | or 'lower' and 'show.diag' is FALSE, whether need to remove the blank label.} 17 | 18 | \item{...}{extra params for \code{\link[ggplot2]{geom_text}}.} 19 | } 20 | \description{ 21 | \code{geom_diag_label} is mainly used with \code{ggcor} and 22 | \code{quickcor} functions to add diagnoal labels on correct position 23 | base on different type of cor_tbl object. 24 | } 25 | \examples{ 26 | quickcor(mtcars, type = "upper") + geom_colour() + geom_diag_label() 27 | quickcor(mtcars, type = "lower") + geom_colour() + geom_diag_label() 28 | } 29 | \seealso{ 30 | \code{\link[ggplot2]{geom_text}}. 31 | } 32 | \author{ 33 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 34 | } 35 | -------------------------------------------------------------------------------- /man/geom_ellipse2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-ellipse2.R 3 | \docType{data} 4 | \name{geom_ellipse2} 5 | \alias{geom_ellipse2} 6 | \alias{geom_upper_ellipse2} 7 | \alias{geom_lower_ellipse2} 8 | \alias{GeomEllipse2} 9 | \alias{GeomUpperEllipse2} 10 | \alias{GeomLowerEllipse2} 11 | \title{Ellipse Geom} 12 | \usage{ 13 | geom_ellipse2( 14 | mapping = NULL, 15 | data = NULL, 16 | stat = "identity", 17 | position = "identity", 18 | ..., 19 | n = 60, 20 | na.rm = FALSE, 21 | show.legend = NA, 22 | inherit.aes = TRUE 23 | ) 24 | 25 | geom_upper_ellipse2( 26 | mapping = NULL, 27 | data = get_data(type = "upper"), 28 | stat = "identity", 29 | position = "identity", 30 | ..., 31 | na.rm = FALSE, 32 | show.legend = NA, 33 | inherit.aes = TRUE 34 | ) 35 | 36 | geom_lower_ellipse2( 37 | mapping = NULL, 38 | data = get_data(type = "lower"), 39 | stat = "identity", 40 | position = "identity", 41 | ..., 42 | na.rm = FALSE, 43 | show.legend = NA, 44 | inherit.aes = TRUE 45 | ) 46 | } 47 | \arguments{ 48 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 49 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 50 | default), it is combined with the default mapping at the top level of the 51 | plot. You must supply \code{mapping} if there is no plot mapping.} 52 | 53 | \item{data}{The data to be displayed in this layer. There are three 54 | options: 55 | 56 | If \code{NULL}, the default, the data is inherited from the plot 57 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 58 | 59 | A \code{data.frame}, or other object, will override the plot 60 | data. All objects will be fortified to produce a data frame. See 61 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 62 | 63 | A \code{function} will be called with a single argument, 64 | the plot data. The return value must be a \code{data.frame}, and 65 | will be used as the layer data. A \code{function} can be created 66 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 67 | 68 | \item{stat}{The statistical transformation to use on the data for this 69 | layer, as a string.} 70 | 71 | \item{position}{Position adjustment, either as a string, or the result of 72 | a call to a position adjustment function.} 73 | 74 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 75 | often aesthetics, used to set an aesthetic to a fixed value, like 76 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 77 | to the paired geom/stat.} 78 | 79 | \item{n}{the number of ellipse path.} 80 | 81 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 82 | a warning. If \code{TRUE}, missing values are silently removed.} 83 | 84 | \item{show.legend}{logical. Should this layer be included in the legends? 85 | \code{NA}, the default, includes if any aesthetics are mapped. 86 | \code{FALSE} never includes, and \code{TRUE} always includes. 87 | It can also be a named logical vector to finely select the aesthetics to 88 | display.} 89 | 90 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 91 | rather than combining with them. This is most useful for helper functions 92 | that define both data and aesthetics and shouldn't inherit behaviour from 93 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 94 | } 95 | \description{ 96 | Ellipse Geom 97 | } 98 | \section{Aesthetics}{ 99 | 100 | \code{geom_ellipse2()}, \code{geom_upper_ellipse2()} and \code{geom_lower_ellipse2()} 101 | understands the following aesthetics (required aesthetics are in bold): 102 | \itemize{ 103 | \item \strong{\code{x}} 104 | \item \strong{\code{y}} 105 | \item \code{r0} 106 | \item \code{alpha} 107 | \item \code{colour} 108 | \item \code{fill} 109 | \item \code{linetype} 110 | \item \code{size} 111 | \item \code{upper_r0} 112 | \item \code{upper_alpha} 113 | \item \code{upper_colour} 114 | \item \code{upper_fill} 115 | \item \code{upper_linetype} 116 | \item \code{upper_size} 117 | \item \code{lower_r0} 118 | \item \code{lower_alpha} 119 | \item \code{lower_colour} 120 | \item \code{lower_fill} 121 | \item \code{lower_linetype} 122 | \item \code{lower_size} 123 | } 124 | } 125 | 126 | \author{ 127 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 128 | } 129 | \keyword{datasets} 130 | -------------------------------------------------------------------------------- /man/geom_hc_rect.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-hc-rect.R 3 | \name{geom_hc_rect} 4 | \alias{geom_hc_rect} 5 | \alias{get_hc_rect_df} 6 | \title{Draw square mark on correlation matrix plot} 7 | \usage{ 8 | geom_hc_rect(data = NULL, fill = NA, colour = "black", size = 2, color = NULL) 9 | 10 | get_hc_rect_df() 11 | } 12 | \arguments{ 13 | \item{data}{a correlation matrix or hc_rect_df object.} 14 | 15 | \item{fill}{NA (default) or the fill colour of square.} 16 | 17 | \item{colour, color}{the colour of square boder.} 18 | 19 | \item{size}{size of square boder line.} 20 | } 21 | \description{ 22 | Draw the cluster square mark on the correlation matrix plot. 23 | } 24 | \author{ 25 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 26 | } 27 | -------------------------------------------------------------------------------- /man/geom_link.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-link.R 3 | \name{geom_link} 4 | \alias{geom_link} 5 | \alias{geom_link_point} 6 | \alias{geom_link_label} 7 | \alias{geom_start_point} 8 | \alias{geom_end_point} 9 | \alias{geom_start_label} 10 | \alias{geom_end_label} 11 | \alias{get_start_nodes} 12 | \alias{get_end_nodes} 13 | \title{Special layer function for correlation link plot} 14 | \usage{ 15 | geom_link( 16 | mapping = NULL, 17 | data = NULL, 18 | curvature = 0, 19 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 20 | ... 21 | ) 22 | 23 | geom_link_point(...) 24 | 25 | geom_link_label(...) 26 | 27 | geom_start_point( 28 | mapping = NULL, 29 | data = NULL, 30 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 31 | ... 32 | ) 33 | 34 | geom_end_point( 35 | mapping = NULL, 36 | data = NULL, 37 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 38 | ... 39 | ) 40 | 41 | geom_start_label( 42 | mapping = NULL, 43 | data = NULL, 44 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 45 | ... 46 | ) 47 | 48 | geom_end_label( 49 | mapping = NULL, 50 | data = NULL, 51 | inherit.aes = getOption("ggcor.link.inherit.aes", TRUE), 52 | ... 53 | ) 54 | 55 | get_start_nodes() 56 | 57 | get_end_nodes() 58 | } 59 | \arguments{ 60 | \item{mapping}{aesthetic mappings parameters.} 61 | 62 | \item{data}{NULL or a layout_link_tbl object that create by 63 | \code{parallel_layout()} or \code{combination_layout()}.} 64 | 65 | \item{curvature}{a numeric value giving the amount of curvature.} 66 | 67 | \item{inherit.aes}{If FALSE, overrides the default aesthetics, rather than 68 | combining with them.} 69 | 70 | \item{...}{extra parameters passing to layer function.} 71 | } 72 | \value{ 73 | geom layer. 74 | } 75 | \description{ 76 | A set of custom layer functions that quickly add 77 | layers of curves, nodes, and labels. 78 | } 79 | \author{ 80 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 81 | } 82 | -------------------------------------------------------------------------------- /man/geom_link2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-link2.R 3 | \docType{data} 4 | \name{geom_link2} 5 | \alias{geom_link2} 6 | \alias{GeomLink2} 7 | \title{Link Geom} 8 | \usage{ 9 | geom_link2( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | ..., 15 | curvature = 0, 16 | angle = 90, 17 | ncp = 5, 18 | arrow = NULL, 19 | arrow.fill = NULL, 20 | lineend = "butt", 21 | na.rm = FALSE, 22 | show.legend = NA, 23 | inherit.aes = TRUE 24 | ) 25 | } 26 | \arguments{ 27 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 28 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 29 | default), it is combined with the default mapping at the top level of the 30 | plot. You must supply \code{mapping} if there is no plot mapping.} 31 | 32 | \item{data}{The data to be displayed in this layer. There are three 33 | options: 34 | 35 | If \code{NULL}, the default, the data is inherited from the plot 36 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 37 | 38 | A \code{data.frame}, or other object, will override the plot 39 | data. All objects will be fortified to produce a data frame. See 40 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 41 | 42 | A \code{function} will be called with a single argument, 43 | the plot data. The return value must be a \code{data.frame}, and 44 | will be used as the layer data. A \code{function} can be created 45 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 46 | 47 | \item{stat}{The statistical transformation to use on the data for this 48 | layer, as a string.} 49 | 50 | \item{position}{Position adjustment, either as a string, or the result of 51 | a call to a position adjustment function.} 52 | 53 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 54 | often aesthetics, used to set an aesthetic to a fixed value, like 55 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 56 | to the paired geom/stat.} 57 | 58 | \item{curvature}{A numeric value giving the amount of curvature. 59 | Negative values produce left-hand curves, positive values 60 | produce right-hand curves, and zero produces a straight line.} 61 | 62 | \item{angle}{A numeric value between 0 and 180, 63 | giving an amount to skew the control 64 | points of the curve. Values less than 90 skew the curve towards 65 | the start point and values greater than 90 skew the curve 66 | towards the end point.} 67 | 68 | \item{ncp}{The number of control points used to draw the curve. 69 | More control points creates a smoother curve.} 70 | 71 | \item{arrow}{specification for arrow heads, as created by arrow().} 72 | 73 | \item{arrow.fill}{fill colour to use for the arrow head (if closed). \code{NULL} 74 | means use \code{colour} aesthetic.} 75 | 76 | \item{lineend}{Line end style (round, butt, square).} 77 | 78 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 79 | a warning. If \code{TRUE}, missing values are silently removed.} 80 | 81 | \item{show.legend}{logical. Should this layer be included in the legends? 82 | \code{NA}, the default, includes if any aesthetics are mapped. 83 | \code{FALSE} never includes, and \code{TRUE} always includes. 84 | It can also be a named logical vector to finely select the aesthetics to 85 | display.} 86 | 87 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 88 | rather than combining with them. This is most useful for helper functions 89 | that define both data and aesthetics and shouldn't inherit behaviour from 90 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 91 | } 92 | \description{ 93 | Link Geom 94 | } 95 | \section{Aesthetics}{ 96 | 97 | \code{geom_link()} understands the following aesthetics (required aesthetics are in bold): 98 | \itemize{ 99 | \item \strong{\code{x}} 100 | \item \strong{\code{y}} 101 | \item \strong{\code{xend}} 102 | \item \strong{\code{yend}} 103 | \item \code{alpha} 104 | \item \code{colour} 105 | \item \code{fill} 106 | \item \code{group} 107 | \item \code{linetype} 108 | \item \code{size} 109 | } 110 | } 111 | 112 | \author{ 113 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 114 | } 115 | \keyword{datasets} 116 | -------------------------------------------------------------------------------- /man/geom_mark.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-mark.R 3 | \docType{data} 4 | \name{geom_mark} 5 | \alias{geom_mark} 6 | \alias{GeomMark} 7 | \title{Significant marks Geom} 8 | \usage{ 9 | geom_mark( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | ..., 15 | nudge_x = 0, 16 | nudge_y = 0, 17 | digits = 2, 18 | nsmall = 2, 19 | sig.level = c(0.05, 0.01, 0.001), 20 | mark = c("*", "**", "***"), 21 | sig.thres = NULL, 22 | sep = "", 23 | parse = FALSE, 24 | na.rm = FALSE, 25 | show.legend = NA, 26 | inherit.aes = TRUE 27 | ) 28 | } 29 | \arguments{ 30 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 31 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 32 | default), it is combined with the default mapping at the top level of the 33 | plot. You must supply \code{mapping} if there is no plot mapping.} 34 | 35 | \item{data}{The data to be displayed in this layer. There are three 36 | options: 37 | 38 | If \code{NULL}, the default, the data is inherited from the plot 39 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 40 | 41 | A \code{data.frame}, or other object, will override the plot 42 | data. All objects will be fortified to produce a data frame. See 43 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 44 | 45 | A \code{function} will be called with a single argument, 46 | the plot data. The return value must be a \code{data.frame}, and 47 | will be used as the layer data. A \code{function} can be created 48 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 49 | 50 | \item{stat}{The statistical transformation to use on the data for this 51 | layer, as a string.} 52 | 53 | \item{position}{Position adjustment, either as a string, or the result of 54 | a call to a position adjustment function.} 55 | 56 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 57 | often aesthetics, used to set an aesthetic to a fixed value, like 58 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 59 | to the paired geom/stat.} 60 | 61 | \item{nudge_x}{Horizontal and vertical adjustment to nudge labels by. 62 | Useful for offsetting text from points, particularly on discrete scales.} 63 | 64 | \item{nudge_y}{Horizontal and vertical adjustment to nudge labels by. 65 | Useful for offsetting text from points, particularly on discrete scales.} 66 | 67 | \item{digits}{integer indicating the number of decimal places (round) or 68 | significant digits (signif) to be used, the default value is 2.} 69 | 70 | \item{nsmall}{the minimum number of digits to the right of the decimal 71 | point in formatting real/complex numbers in non-scientific formats, 72 | the default value is 2.} 73 | 74 | \item{sig.level}{significance level，the default values is [0.05, 0.01, 0.001].} 75 | 76 | \item{mark}{significance mark，the default values is ["*", "**", "***"].} 77 | 78 | \item{sig.thres}{if not NULL, just when p.value is not larger than sig.thres will be ploted.} 79 | 80 | \item{sep}{a character string to separate the number and mark symbols.} 81 | 82 | \item{parse}{If \code{TRUE}, the labels will be parsed into expressions and 83 | displayed as described in \code{?plotmath}.} 84 | 85 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 86 | a warning. If \code{TRUE}, missing values are silently removed.} 87 | 88 | \item{show.legend}{logical. Should this layer be included in the legends? 89 | \code{NA}, the default, includes if any aesthetics are mapped. 90 | \code{FALSE} never includes, and \code{TRUE} always includes. 91 | It can also be a named logical vector to finely select the aesthetics to 92 | display.} 93 | 94 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 95 | rather than combining with them. This is most useful for helper functions 96 | that define both data and aesthetics and shouldn't inherit behaviour from 97 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 98 | } 99 | \description{ 100 | Significant marks Geom 101 | } 102 | \section{Aesthetics}{ 103 | 104 | \code{geom_mark()} understands the following aesthetics (required 105 | aesthetics are in bold): 106 | \itemize{ 107 | \item \strong{\code{x}} 108 | \item \strong{\code{y}} 109 | \item \strong{\code{p.value}} 110 | \item \code{r} 111 | \item \code{alpha} 112 | \item \code{colour} 113 | \item \code{size} 114 | \item \code{angle} 115 | \item \code{hjust} 116 | \item \code{vjust} 117 | \item \code{family} 118 | \item \code{fontface} 119 | \item \code{lineheight} 120 | } 121 | } 122 | 123 | \author{ 124 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 125 | } 126 | \keyword{datasets} 127 | -------------------------------------------------------------------------------- /man/geom_number.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-num.R 3 | \docType{data} 4 | \name{geom_number} 5 | \alias{geom_number} 6 | \alias{GeomNumber} 7 | \title{Format number Geom} 8 | \usage{ 9 | geom_number( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | ..., 15 | nudge_x = 0, 16 | nudge_y = 0, 17 | digits = 2, 18 | nsmall = 2, 19 | na.rm = FALSE, 20 | show.legend = NA, 21 | inherit.aes = TRUE 22 | ) 23 | } 24 | \arguments{ 25 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 26 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 27 | default), it is combined with the default mapping at the top level of the 28 | plot. You must supply \code{mapping} if there is no plot mapping.} 29 | 30 | \item{data}{The data to be displayed in this layer. There are three 31 | options: 32 | 33 | If \code{NULL}, the default, the data is inherited from the plot 34 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 35 | 36 | A \code{data.frame}, or other object, will override the plot 37 | data. All objects will be fortified to produce a data frame. See 38 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 39 | 40 | A \code{function} will be called with a single argument, 41 | the plot data. The return value must be a \code{data.frame}, and 42 | will be used as the layer data. A \code{function} can be created 43 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 44 | 45 | \item{stat}{The statistical transformation to use on the data for this 46 | layer, as a string.} 47 | 48 | \item{position}{Position adjustment, either as a string, or the result of 49 | a call to a position adjustment function.} 50 | 51 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 52 | often aesthetics, used to set an aesthetic to a fixed value, like 53 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 54 | to the paired geom/stat.} 55 | 56 | \item{nudge_x}{Horizontal and vertical adjustment to nudge labels by. 57 | Useful for offsetting text from points, particularly on discrete scales.} 58 | 59 | \item{nudge_y}{Horizontal and vertical adjustment to nudge labels by. 60 | Useful for offsetting text from points, particularly on discrete scales.} 61 | 62 | \item{digits}{integer indicating the number of decimal places (round) or 63 | significant digits (signif) to be used, the default value is 2.} 64 | 65 | \item{nsmall}{the minimum number of digits to the right of the decimal 66 | point in formatting real/complex numbers in non-scientific formats, 67 | the default value is 2.} 68 | 69 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 70 | a warning. If \code{TRUE}, missing values are silently removed.} 71 | 72 | \item{show.legend}{logical. Should this layer be included in the legends? 73 | \code{NA}, the default, includes if any aesthetics are mapped. 74 | \code{FALSE} never includes, and \code{TRUE} always includes. 75 | It can also be a named logical vector to finely select the aesthetics to 76 | display.} 77 | 78 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 79 | rather than combining with them. This is most useful for helper functions 80 | that define both data and aesthetics and shouldn't inherit behaviour from 81 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 82 | } 83 | \description{ 84 | Format number Geom 85 | } 86 | \section{Aesthetics}{ 87 | 88 | \code{geom_number()} understands the following aesthetics (required 89 | aesthetics are in bold): 90 | \itemize{ 91 | \item \strong{\code{x}} 92 | \item \strong{\code{y}} 93 | \item \strong{\code{num}} 94 | \item \code{alpha} 95 | \item \code{colour} 96 | \item \code{size} 97 | \item \code{angle} 98 | \item \code{hjust} 99 | \item \code{vjust} 100 | \item \code{family} 101 | \item \code{fontface} 102 | \item \code{lineheight} 103 | } 104 | } 105 | 106 | \author{ 107 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 108 | } 109 | \keyword{datasets} 110 | -------------------------------------------------------------------------------- /man/geom_panel_grid.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-panel-grid.R 3 | \name{geom_panel_grid} 4 | \alias{geom_panel_grid} 5 | \alias{add_grid} 6 | \title{Add panel grid line on correlation plot} 7 | \usage{ 8 | geom_panel_grid(data = NULL, colour = "grey50", size = 0.25, ..., color = NULL) 9 | } 10 | \arguments{ 11 | \item{data}{NULL (default) or a cor_tbl object.} 12 | 13 | \item{colour, color}{colour of grid lines.} 14 | 15 | \item{size}{size of grid lines.} 16 | 17 | \item{...}{extra params for \code{\link[ggplot2]{geom_segment}}.} 18 | } 19 | \description{ 20 | \code{geom_grid} is mainly used with \code{ggcor} or \code{quickcor} 21 | function to add a panel grid line on plot region. 22 | } 23 | \examples{ 24 | df <- fortify_cor(mtcars) 25 | ggcor(df) + geom_panel_grid() 26 | require(ggplot2, quietly = TRUE) 27 | ggplot(df, aes(x, y)) + geom_panel_grid() 28 | } 29 | \author{ 30 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 31 | } 32 | -------------------------------------------------------------------------------- /man/geom_shade.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-shade.R 3 | \docType{data} 4 | \name{geom_shade} 5 | \alias{geom_shade} 6 | \alias{GeomShade} 7 | \title{Shade Geom} 8 | \usage{ 9 | geom_shade( 10 | mapping = NULL, 11 | data = NULL, 12 | stat = "identity", 13 | position = "identity", 14 | ..., 15 | sign = 1, 16 | na.rm = FALSE, 17 | show.legend = NA, 18 | inherit.aes = TRUE 19 | ) 20 | } 21 | \arguments{ 22 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 23 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 24 | default), it is combined with the default mapping at the top level of the 25 | plot. You must supply \code{mapping} if there is no plot mapping.} 26 | 27 | \item{data}{The data to be displayed in this layer. There are three 28 | options: 29 | 30 | If \code{NULL}, the default, the data is inherited from the plot 31 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 32 | 33 | A \code{data.frame}, or other object, will override the plot 34 | data. All objects will be fortified to produce a data frame. See 35 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 36 | 37 | A \code{function} will be called with a single argument, 38 | the plot data. The return value must be a \code{data.frame}, and 39 | will be used as the layer data. A \code{function} can be created 40 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 41 | 42 | \item{stat}{The statistical transformation to use on the data for this 43 | layer, as a string.} 44 | 45 | \item{position}{Position adjustment, either as a string, or the result of 46 | a call to a position adjustment function.} 47 | 48 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 49 | often aesthetics, used to set an aesthetic to a fixed value, like 50 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 51 | to the paired geom/stat.} 52 | 53 | \item{sign}{scalar numeric value. If less than 0, add shade on cells with 54 | negtive \code{r} values. If larger than 0, add shade on cells with positive 55 | \code{r} values. If equals 0, add shade on cells except where \code{r} values 56 | equals 0.} 57 | 58 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 59 | a warning. If \code{TRUE}, missing values are silently removed.} 60 | 61 | \item{show.legend}{logical. Should this layer be included in the legends? 62 | \code{NA}, the default, includes if any aesthetics are mapped. 63 | \code{FALSE} never includes, and \code{TRUE} always includes. 64 | It can also be a named logical vector to finely select the aesthetics to 65 | display.} 66 | 67 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 68 | rather than combining with them. This is most useful for helper functions 69 | that define both data and aesthetics and shouldn't inherit behaviour from 70 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 71 | } 72 | \description{ 73 | Shade Geom 74 | } 75 | \section{Aesthetics}{ 76 | 77 | \code{geom_shade()} understands the following aesthetics (required 78 | aesthetics are in bold): 79 | \itemize{ 80 | \item \strong{\code{x}} 81 | \item \strong{\code{y}} 82 | \item \strong{\code{r0}} 83 | \item \code{alpha} 84 | \item \code{colour} 85 | \item \code{linetype} 86 | \item \code{size} 87 | } 88 | } 89 | 90 | \author{ 91 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 92 | } 93 | \keyword{datasets} 94 | -------------------------------------------------------------------------------- /man/geom_square.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-square.R 3 | \docType{data} 4 | \name{geom_square} 5 | \alias{geom_square} 6 | \alias{geom_upper_square} 7 | \alias{geom_lower_square} 8 | \alias{GeomSquare} 9 | \alias{GeomUpperSquare} 10 | \alias{GeomLowerSquare} 11 | \title{Square Geom} 12 | \usage{ 13 | geom_square( 14 | mapping = NULL, 15 | data = NULL, 16 | stat = "identity", 17 | position = "identity", 18 | ..., 19 | na.rm = FALSE, 20 | show.legend = NA, 21 | inherit.aes = TRUE 22 | ) 23 | 24 | geom_upper_square( 25 | mapping = NULL, 26 | data = get_data(type = "upper"), 27 | stat = "identity", 28 | position = "identity", 29 | ..., 30 | na.rm = FALSE, 31 | show.legend = NA, 32 | inherit.aes = TRUE 33 | ) 34 | 35 | geom_lower_square( 36 | mapping = NULL, 37 | data = get_data(type = "lower"), 38 | stat = "identity", 39 | position = "identity", 40 | ..., 41 | na.rm = FALSE, 42 | show.legend = NA, 43 | inherit.aes = TRUE 44 | ) 45 | } 46 | \arguments{ 47 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 48 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 49 | default), it is combined with the default mapping at the top level of the 50 | plot. You must supply \code{mapping} if there is no plot mapping.} 51 | 52 | \item{data}{The data to be displayed in this layer. There are three 53 | options: 54 | 55 | If \code{NULL}, the default, the data is inherited from the plot 56 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 57 | 58 | A \code{data.frame}, or other object, will override the plot 59 | data. All objects will be fortified to produce a data frame. See 60 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 61 | 62 | A \code{function} will be called with a single argument, 63 | the plot data. The return value must be a \code{data.frame}, and 64 | will be used as the layer data. A \code{function} can be created 65 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 66 | 67 | \item{stat}{The statistical transformation to use on the data for this 68 | layer, as a string.} 69 | 70 | \item{position}{Position adjustment, either as a string, or the result of 71 | a call to a position adjustment function.} 72 | 73 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 74 | often aesthetics, used to set an aesthetic to a fixed value, like 75 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 76 | to the paired geom/stat.} 77 | 78 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 79 | a warning. If \code{TRUE}, missing values are silently removed.} 80 | 81 | \item{show.legend}{logical. Should this layer be included in the legends? 82 | \code{NA}, the default, includes if any aesthetics are mapped. 83 | \code{FALSE} never includes, and \code{TRUE} always includes. 84 | It can also be a named logical vector to finely select the aesthetics to 85 | display.} 86 | 87 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 88 | rather than combining with them. This is most useful for helper functions 89 | that define both data and aesthetics and shouldn't inherit behaviour from 90 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 91 | } 92 | \description{ 93 | Square Geom 94 | } 95 | \section{Aesthetics}{ 96 | 97 | \code{geom_square()}, \code{geom_upper_square()} and \code{geom_lower_square()} 98 | understands the following aesthetics (required aesthetics are in bold): 99 | \itemize{ 100 | \item \strong{\code{x}} 101 | \item \strong{\code{y}} 102 | \item \code{r0} 103 | \item \code{alpha} 104 | \item \code{colour} 105 | \item \code{fill} 106 | \item \code{linetype} 107 | \item \code{size} 108 | \item \code{upper_r0} 109 | \item \code{upper_alpha} 110 | \item \code{upper_colour} 111 | \item \code{upper_fill} 112 | \item \code{upper_linetype} 113 | \item \code{upper_size} 114 | \item \code{lower_r0} 115 | \item \code{lower_alpha} 116 | \item \code{lower_colour} 117 | \item \code{lower_fill} 118 | \item \code{lower_linetype} 119 | \item \code{lower_size} 120 | } 121 | } 122 | 123 | \author{ 124 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 125 | } 126 | \keyword{datasets} 127 | -------------------------------------------------------------------------------- /man/geom_star.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geom-star.R 3 | \docType{data} 4 | \name{geom_star} 5 | \alias{geom_star} 6 | \alias{geom_upper_star} 7 | \alias{geom_lower_star} 8 | \alias{GeomStar} 9 | \alias{GeomUpperStar} 10 | \alias{GeomLowerStar} 11 | \title{Star Geom} 12 | \usage{ 13 | geom_star( 14 | mapping = NULL, 15 | data = NULL, 16 | stat = "identity", 17 | position = "identity", 18 | ..., 19 | na.rm = FALSE, 20 | show.legend = NA, 21 | inherit.aes = TRUE 22 | ) 23 | 24 | geom_upper_star( 25 | mapping = NULL, 26 | data = get_data(type = "upper"), 27 | stat = "identity", 28 | position = "identity", 29 | ..., 30 | na.rm = FALSE, 31 | show.legend = NA, 32 | inherit.aes = TRUE 33 | ) 34 | 35 | geom_lower_star( 36 | mapping = NULL, 37 | data = get_data(type = "lower"), 38 | stat = "identity", 39 | position = "identity", 40 | ..., 41 | na.rm = FALSE, 42 | show.legend = NA, 43 | inherit.aes = TRUE 44 | ) 45 | } 46 | \arguments{ 47 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}} or 48 | \code{\link[ggplot2:aes_]{aes_()}}. If specified and \code{inherit.aes = TRUE} (the 49 | default), it is combined with the default mapping at the top level of the 50 | plot. You must supply \code{mapping} if there is no plot mapping.} 51 | 52 | \item{data}{The data to be displayed in this layer. There are three 53 | options: 54 | 55 | If \code{NULL}, the default, the data is inherited from the plot 56 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 57 | 58 | A \code{data.frame}, or other object, will override the plot 59 | data. All objects will be fortified to produce a data frame. See 60 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 61 | 62 | A \code{function} will be called with a single argument, 63 | the plot data. The return value must be a \code{data.frame}, and 64 | will be used as the layer data. A \code{function} can be created 65 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 66 | 67 | \item{stat}{The statistical transformation to use on the data for this 68 | layer, as a string.} 69 | 70 | \item{position}{Position adjustment, either as a string, or the result of 71 | a call to a position adjustment function.} 72 | 73 | \item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are 74 | often aesthetics, used to set an aesthetic to a fixed value, like 75 | \code{colour = "red"} or \code{size = 3}. They may also be parameters 76 | to the paired geom/stat.} 77 | 78 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 79 | a warning. If \code{TRUE}, missing values are silently removed.} 80 | 81 | \item{show.legend}{logical. Should this layer be included in the legends? 82 | \code{NA}, the default, includes if any aesthetics are mapped. 83 | \code{FALSE} never includes, and \code{TRUE} always includes. 84 | It can also be a named logical vector to finely select the aesthetics to 85 | display.} 86 | 87 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 88 | rather than combining with them. This is most useful for helper functions 89 | that define both data and aesthetics and shouldn't inherit behaviour from 90 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 91 | } 92 | \description{ 93 | Star Geom 94 | } 95 | \section{Aesthetics}{ 96 | 97 | \code{geom_star()}, \code{geom_upper_star()} and \code{geom_lower_star()} 98 | understands the following aesthetics (required aesthetics are in bold): 99 | \itemize{ 100 | \item \strong{\code{x}} 101 | \item \strong{\code{y}} 102 | \item \code{n} 103 | \item \code{r0} 104 | \item \code{ratio} 105 | \item \code{alpha} 106 | \item \code{colour} 107 | \item \code{fill} 108 | \item \code{linetype} 109 | \item \code{size} 110 | \item \code{upper_n} 111 | \item \code{upper_r0} 112 | \item \code{upper_ratio} 113 | \item \code{upper_alpha} 114 | \item \code{upper_colour} 115 | \item \code{upper_fill} 116 | \item \code{upper_linetype} 117 | \item \code{upper_size} 118 | \item \code{lower_n} 119 | \item \code{lower_r0} 120 | \item \code{lower_ratio} 121 | \item \code{lower_alpha} 122 | \item \code{lower_colour} 123 | \item \code{lower_fill} 124 | \item \code{lower_linetype} 125 | \item \code{lower_size} 126 | } 127 | } 128 | 129 | \author{ 130 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 131 | } 132 | \keyword{datasets} 133 | -------------------------------------------------------------------------------- /man/get_attr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor-tbl-utils.R 3 | \name{get_row_name} 4 | \alias{get_row_name} 5 | \alias{get_col_name} 6 | \alias{get_type} 7 | \alias{get_show_diag} 8 | \alias{is_cor_tbl} 9 | \alias{is_general_cor_tbl} 10 | \title{Helper function of cor_tbl} 11 | \usage{ 12 | get_row_name(x) 13 | 14 | get_col_name(x) 15 | 16 | get_type(x) 17 | 18 | get_show_diag(x) 19 | 20 | is_cor_tbl(x) 21 | 22 | is_general_cor_tbl(x) 23 | } 24 | \arguments{ 25 | \item{x}{a cor_tbl.} 26 | } 27 | \value{ 28 | return attribute value. 29 | } 30 | \description{ 31 | Helper function of cor_tbl 32 | } 33 | \examples{ 34 | df <- fortify_cor(mtcars) 35 | ## get rows names 36 | get_row_name(df) 37 | 38 | ## get columns names 39 | get_col_name(df) 40 | 41 | ## get show.diag parameter 42 | get_show_diag(df) 43 | 44 | ## get type parameter 45 | get_type(df) 46 | } 47 | \author{ 48 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 49 | } 50 | -------------------------------------------------------------------------------- /man/get_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get-data.R 3 | \name{get_data} 4 | \alias{get_data} 5 | \title{Create cor_tbl extractor function} 6 | \usage{ 7 | get_data(..., type = "full", show.diag = FALSE) 8 | } 9 | \arguments{ 10 | \item{...}{extra filter params, see Details.} 11 | 12 | \item{type}{a string, "full" (default), "upper" or "lower", display full, 13 | lower triangular or upper triangular matrix.} 14 | 15 | \item{show.diag}{a logical value indicating whether keep the diagonal.} 16 | } 17 | \value{ 18 | extractor function 19 | } 20 | \description{ 21 | This function returns another function that can extract cor_tbl 22 | subset from a cor_tbl object. 23 | } 24 | \details{ 25 | This function is mainly used in \code{ggplot2} geom_*() functions, 26 | where data is filtered based on the \code{...} parameter, then subsets 27 | are extracted based on the type and show.diag parameters. 28 | } 29 | \examples{ 30 | ## arrange different elements in upper and lower 31 | quickcor(mtcars) + 32 | geom_colour(data = get_data(type = "lower")) + 33 | geom_ellipse2(data = get_data(type = "upper")) + 34 | add_diag_label() + 35 | remove_axis() 36 | 37 | quickcor(mtcars, cor.test = TRUE) + 38 | geom_ellipse2(data = get_data(type = "upper")) + 39 | geom_mark(data = get_data(type = "lower")) + 40 | add_diag_label() + 41 | remove_axis() 42 | } 43 | \seealso{ 44 | \code{\link[dplyr]{filter}}. 45 | } 46 | \author{ 47 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 48 | } 49 | -------------------------------------------------------------------------------- /man/ggcor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggcor.R 3 | \name{ggcor} 4 | \alias{ggcor} 5 | \title{Create a correlation plot} 6 | \usage{ 7 | ggcor( 8 | data, 9 | mapping = NULL, 10 | axis.x.position = "auto", 11 | axis.y.position = "auto", 12 | axis.label.drop = TRUE 13 | ) 14 | } 15 | \arguments{ 16 | \item{data}{cor_tbl object.} 17 | 18 | \item{mapping}{NULL (default) or a list of aesthetic mappings to use for plot.} 19 | 20 | \item{axis.x.position, axis.y.position}{the position of the axis. 'auto' (default) 21 | is set according to the plot type, 'bottom' or 'top' for x axes, 'left' or 'right' 22 | for y axes.} 23 | 24 | \item{axis.label.drop}{logical value (default is TRUE). When type of plot is 'upper' 25 | or 'lower' and 'show.diag' is FALSE, do you need to remove the blank coordinate 26 | label.} 27 | } 28 | \value{ 29 | an object of class gg onto which layers, scales, etc. can be added. 30 | } 31 | \description{ 32 | This function is the equivalent of \code{\link[ggplot2]{ggplot}} 33 | in ggplot2. It takes care of setting up the position of axis and legend for 34 | the plot based on the plot type. 35 | } 36 | \examples{ 37 | df <- fortify_cor(mtcars) 38 | ggcor(df) 39 | df01 <- fortify_cor(mtcars, type = "lower", show.diag = FALSE) 40 | ggcor(df01, axis.label.drop = TRUE) 41 | } 42 | \author{ 43 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 44 | } 45 | -------------------------------------------------------------------------------- /man/link_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-link-extra-params.R 3 | \name{link_params} 4 | \alias{link_params} 5 | \title{Control the points position of link} 6 | \usage{ 7 | link_params( 8 | env.point.hjust = NULL, 9 | env.point.vjust = NULL, 10 | spec.point.hjust = NULL, 11 | spec.point.vjust = NULL 12 | ) 13 | } 14 | \arguments{ 15 | \item{env.point.hjust, env.point.vjust}{a numeric vector is used to set the distance that 16 | points (close to the correlation matrix) moves horizontally or vertically.} 17 | 18 | \item{spec.point.hjust, spec.point.vjust}{a numeric vector is used to set the distance that 19 | points (away from the correlation matrix) moves horizontally or vertically.} 20 | } 21 | \description{ 22 | This is mainly used in the add_link function to control points position. 23 | } 24 | \author{ 25 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 26 | } 27 | -------------------------------------------------------------------------------- /man/mantel_test.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/fortify-mantel.R 3 | \name{mantel_test} 4 | \alias{mantel_test} 5 | \title{Mantel and partial mantel test for dissimilarity matrices} 6 | \usage{ 7 | mantel_test( 8 | spec, 9 | env, 10 | env.ctrl = NULL, 11 | mantel.fun = "mantel", 12 | spec.select = NULL, 13 | env.select = NULL, 14 | spec.dist.method = "bray", 15 | env.dist.method = "euclidean", 16 | ... 17 | ) 18 | } 19 | \arguments{ 20 | \item{spec, env}{data frame object.} 21 | 22 | \item{env.ctrl}{NULL (default), data frame.} 23 | 24 | \item{mantel.fun}{string, function of mantel test. 25 | \itemize{ 26 | \item{\code{"mantel"} will use \code{vegan::mantel} (default).} 27 | \item{\code{"mantel.randtest"} will use \code{ade4::mantel.randtest}.} 28 | \item{\code{"mantel.rtest"} will use \code{ade4::mantel.rtest}.} 29 | \item{\code{"mantel.partial"} will use \code{vegan::mantel.partial} (default).} 30 | }} 31 | 32 | \item{spec.select, env.select}{NULL (default), numeric or character vector index of columns.} 33 | 34 | \item{spec.dist.method}{dissimilarity index (default is 'bray'), pass to \code{method} 35 | params of \code{\link[vegan]{vegdist}}.} 36 | 37 | \item{env.dist.method}{dissimilarity index (default is euclidean'), pass to \code{method} 38 | params of \code{\link[vegan]{vegdist}}.} 39 | 40 | \item{...}{extra params for \code{mantel.fun}.} 41 | } 42 | \description{ 43 | Perform mantel test quickly and tidy up the data to 44 | data frame. 45 | } 46 | \examples{ 47 | library(vegan) 48 | data("varespec") 49 | data("varechem") 50 | mantel_test(varespec, varechem) 51 | mantel_test(varespec, varechem, mantel.fun = "mantel.randtest") 52 | mantel_test(varespec, varechem, mantel.fun = "mantel.randtest", 53 | spec.select = list(spec01 = 1:6, spec02 = 7:12)) 54 | mantel_test(varespec, varechem, mantel.fun = "mantel.randtest", 55 | spec.select = list(spec01 = 1:6, spec02 = 7:12), 56 | env.select = list(env01 = 1:4, env02 = 5:14)) 57 | nm <- names(varechem[1:9]) 58 | mantel_test(varespec, varechem, env.ctrl = varechem[10:14], 59 | mantel.fun = "mantel.partial", 60 | env.select = as.list(setNames(nm, nm))) 61 | } 62 | \seealso{ 63 | \code{\link[vegan]{vegdist}}, \code{\link[vegan]{mantel}}, 64 | \code{\link[ade4]{mantel.rtest}}, \code{\link[ade4]{mantel.randtest}}. 65 | } 66 | \author{ 67 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 68 | } 69 | -------------------------------------------------------------------------------- /man/matrix_order.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/matrix-order.R 3 | \name{matrix_order} 4 | \alias{matrix_order} 5 | \alias{tidy_hc_rect} 6 | \title{Reorder Matrices} 7 | \usage{ 8 | matrix_order(x, is.cor = TRUE, k = 2, cluster.method = "complete", ...) 9 | 10 | tidy_hc_rect(x, k = 2, cluster.method = "complete", ...) 11 | } 12 | \arguments{ 13 | \item{x}{a matrix-like object.} 14 | 15 | \item{is.cor}{logical value (defaults to TRUE) indicating wheater 16 | \code{x} is a correlation matrix.} 17 | 18 | \item{k}{integer, the number of cluster group.} 19 | 20 | \item{cluster.method}{a character string with the name of agglomeration method.} 21 | 22 | \item{...}{extra params passing to \code{\link[stats]{hclust}}.} 23 | } 24 | \value{ 25 | a numeric vector of new order. 26 | } 27 | \description{ 28 | Tries to find an order for matrix by different cluster methods. 29 | } 30 | \details{ 31 | Now it just supports for square matrix. 32 | } 33 | \examples{ 34 | m <- matrix(rnorm(25), nrow = 5) 35 | matrix_order(m) 36 | } 37 | \seealso{ 38 | \code{\link[stats]{hclust}}. 39 | } 40 | \author{ 41 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 42 | } 43 | -------------------------------------------------------------------------------- /man/point_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-link-extra-params.R 3 | \name{point_params} 4 | \alias{point_params} 5 | \title{Extra points params} 6 | \usage{ 7 | point_params( 8 | alpha = NA, 9 | colour = "black", 10 | fill = NA, 11 | shape = 21, 12 | size = 1, 13 | stroke = 0.5, 14 | color = NULL 15 | ) 16 | } 17 | \arguments{ 18 | \item{alpha}{alpha channel for transparency.} 19 | 20 | \item{colour, color}{colour of points.} 21 | 22 | \item{fill}{fill colour of points.} 23 | 24 | \item{shape}{shape of points.} 25 | 26 | \item{size}{size of points.} 27 | 28 | \item{stroke}{stroke of points.} 29 | } 30 | \description{ 31 | This is mainly used in the add_link function to control points style. 32 | } 33 | \author{ 34 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 35 | } 36 | -------------------------------------------------------------------------------- /man/print.correlate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor-test.R 3 | \name{print.correlate} 4 | \alias{print.correlate} 5 | \title{Print for correlate object.} 6 | \usage{ 7 | \method{print}{correlate}(x, all = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{an object used to select a method.} 11 | 12 | \item{all}{if FALSE (default) just print correlation matrix, else will 13 | print all values.} 14 | 15 | \item{...}{extra params passing to \code{print}.} 16 | } 17 | \description{ 18 | Print for correlate object. 19 | } 20 | \examples{ 21 | m <- correlate(mtcars, cor.test = TRUE) 22 | print(m) 23 | print(m, TRUE) 24 | } 25 | \author{ 26 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 27 | } 28 | -------------------------------------------------------------------------------- /man/quick_cor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/quickcor.R 3 | \name{quickcor} 4 | \alias{quickcor} 5 | \title{Plot Correlation Matrix Quickly} 6 | \usage{ 7 | quickcor( 8 | x, 9 | y = NULL, 10 | mapping = NULL, 11 | grid.colour = "grey50", 12 | grid.size = 0.25, 13 | axis.x.position = "auto", 14 | axis.y.position = "auto", 15 | axis.label.drop = TRUE, 16 | legend.position = "auto", 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{x, y}{matrix or data frame.} 22 | 23 | \item{mapping}{NULL (default) or a list of aesthetic mappings to use for plot.} 24 | 25 | \item{grid.colour}{colour of grid lines.} 26 | 27 | \item{grid.size}{size of grid lines.} 28 | 29 | \item{axis.x.position, axis.y.position}{the position of the axis. 'auto' (default) 30 | is set according to the plot type, 'bottom' or 'top' for x axes, 'left' or 'right' 31 | for y axes.} 32 | 33 | \item{axis.label.drop}{logical value (default is TRUE). When type of plot is 'upper' 34 | or 'lower' and 'show.diag' is FALSE, do you need to remove the blank coordinate 35 | label.} 36 | 37 | \item{legend.position}{position of legend.} 38 | 39 | \item{...}{extra params for \code{\link[ggcor]{fortify_cor}}.} 40 | } 41 | \description{ 42 | quickcor is convenient wrapper for creating a number of different types 43 | of correlation matrix plots because of adding some extra settings by default. 44 | } 45 | \examples{ 46 | require(ggplot2, quietly = TRUE) 47 | quickcor(mtcars) 48 | quickcor(mtcars, type = "upper") 49 | quickcor(mtcars, type = "lower", show.diag = FALSE) 50 | quickcor(mtcars) + geom_colour() 51 | quickcor(mtcars, type = "upper") + geom_circle2() 52 | quickcor(mtcars, type = "lower", show.diag = FALSE) + geom_ellipse2() 53 | quickcor(mtcars, cluster = TRUE) + geom_square() 54 | quickcor(mtcars, cor.test = TRUE) + geom_confbox() 55 | quickcor(mtcars, cor.test = TRUE) + geom_colour() + geom_cross() 56 | quickcor(mtcars, cor.test = TRUE) + geom_star(n = 5) 57 | quickcor(mtcars, cor.test = TRUE) + geom_colour() + geom_number(aes(num = r)) 58 | quickcor(mtcars, cor.test = TRUE) + 59 | geom_square(data = get_data(type = "lower", show.diag = FALSE)) + 60 | geom_mark(data = get_data(type = "upper", show.diag = FALSE)) + 61 | geom_abline(slope = -1, intercept = 12) 62 | } 63 | \seealso{ 64 | \code{\link[ggcor]{fortify_cor}}. 65 | } 66 | \author{ 67 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 68 | } 69 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/reexport.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{ggplot_add} 7 | \alias{aes} 8 | \alias{\%>\%} 9 | \alias{filter} 10 | \alias{mutate} 11 | \alias{group_by} 12 | \alias{ungroup} 13 | \alias{as_tibble} 14 | \alias{as_tbl_graph} 15 | \alias{as.igraph} 16 | \title{Objects exported from other packages} 17 | \keyword{internal} 18 | \description{ 19 | These objects are imported from other packages. Follow the links 20 | below to see their documentation. 21 | 22 | \describe{ 23 | \item{dplyr}{\code{\link[dplyr]{\%>\%}}, \code{\link[dplyr]{filter}}, \code{\link[dplyr]{group_by}}, \code{\link[dplyr]{mutate}}, \code{\link[dplyr]{ungroup}}} 24 | 25 | \item{ggplot2}{\code{\link[ggplot2]{aes}}, \code{\link[ggplot2]{ggplot_add}}} 26 | 27 | \item{igraph}{\code{\link[igraph]{as.igraph}}} 28 | 29 | \item{tibble}{\code{\link[tibble]{as_tibble}}} 30 | 31 | \item{tidygraph}{\code{\link[tidygraph]{as_tbl_graph}}} 32 | }} 33 | 34 | -------------------------------------------------------------------------------- /man/remove_axis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/remove-axis.R 3 | \name{remove_axis} 4 | \alias{remove_axis} 5 | \alias{remove_all_axis} 6 | \alias{remove_x_axis} 7 | \alias{remove_y_axis} 8 | \title{Remove axis elements.} 9 | \usage{ 10 | remove_axis(index = c("all", "x", "y")) 11 | 12 | remove_all_axis() 13 | 14 | remove_x_axis() 15 | 16 | remove_y_axis() 17 | } 18 | \arguments{ 19 | \item{index}{'all' (default), 'x' or 'y' axis will be removed.} 20 | } 21 | \value{ 22 | The theme. 23 | } 24 | \description{ 25 | A simple wrapper of the \code{\link[ggplot2]{theme}} function 26 | to quickly remove axis elements. 27 | } 28 | \examples{ 29 | quickcor(mtcars) + geom_circle2() + remove_axis() 30 | quickcor(mtcars) + geom_circle2() + remove_axis("x") 31 | quickcor(mtcars) + geom_circle2() + remove_axis("y") 32 | } 33 | \author{ 34 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 35 | } 36 | -------------------------------------------------------------------------------- /man/scale_radius.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scale-radius.R 3 | \name{scale_radius_area} 4 | \alias{scale_radius_area} 5 | \title{Scale radius} 6 | \usage{ 7 | scale_radius_area(..., range = c(-1, 1), midpoint = 0, guide = "legend") 8 | } 9 | \arguments{ 10 | \item{...}{Arguments passed on to \code{continuous_scale} 11 | \describe{ 12 | \item{name}{The name of the scale. Used as the axis or legend title. If 13 | \code{waiver()}, the default, the name of the scale is taken from the first 14 | mapping used for that aesthetic. If \code{NULL}, the legend title will be 15 | omitted.} 16 | \item{breaks}{One of: 17 | \itemize{ 18 | \item \code{NULL} for no breaks 19 | \item \code{waiver()} for the default breaks computed by the 20 | transformation object 21 | \item A numeric vector of positions 22 | \item A function that takes the limits as input and returns breaks 23 | as output 24 | }} 25 | \item{minor_breaks}{One of: 26 | \itemize{ 27 | \item \code{NULL} for no minor breaks 28 | \item \code{waiver()} for the default breaks (one minor break between 29 | each major break) 30 | \item A numeric vector of positions 31 | \item A function that given the limits returns a vector of minor breaks. 32 | }} 33 | \item{labels}{One of: 34 | \itemize{ 35 | \item \code{NULL} for no labels 36 | \item \code{waiver()} for the default labels computed by the 37 | transformation object 38 | \item A character vector giving labels (must be same length as \code{breaks}) 39 | \item A function that takes the breaks as input and returns labels 40 | as output 41 | }} 42 | \item{limits}{One of: 43 | \itemize{ 44 | \item \code{NULL} to use the default scale range 45 | \item A numeric vector of length two providing limits of the scale. 46 | Use \code{NA} to refer to the existing minimum or maximum 47 | \item A function that accepts the existing (automatic) limits and returns 48 | new limits 49 | }} 50 | \item{oob}{Function that handles limits outside of the scale limits 51 | (out of bounds). The default replaces out of bounds values with \code{NA}.} 52 | \item{na.value}{Missing values will be replaced with this value.} 53 | \item{trans}{Either the name of a transformation object, or the 54 | object itself. Built-in transformations include "asn", "atanh", 55 | "boxcox", "date", "exp", "hms", "identity", "log", "log10", "log1p", "log2", 56 | "logit", "modulus", "probability", "probit", "pseudo_log", "reciprocal", 57 | "reverse", "sqrt" and "time". 58 | 59 | A transformation object bundles together a transform, its inverse, 60 | and methods for generating breaks and labels. Transformation objects 61 | are defined in the scales package, and are called \code{name_trans}, e.g. 62 | \code{\link[scales:boxcox_trans]{scales::boxcox_trans()}}. You can create your own 63 | transformation with \code{\link[scales:trans_new]{scales::trans_new()}}.} 64 | \item{guide}{A function used to create a guide or its name. See 65 | \code{\link[ggplot2:guides]{guides()}} for more info.} 66 | \item{position}{The position of the axis. "left" or "right" for vertical 67 | scales, "top" or "bottom" for horizontal scales} 68 | \item{super}{The super class to use for the constructed scale} 69 | \item{expand}{Vector of range expansion constants used to add some 70 | padding around the data, to ensure that they are placed some distance 71 | away from the axes. Use the convenience function \code{\link[ggplot2:expand_scale]{expand_scale()}} 72 | to generate the values for the \code{expand} argument. The defaults are to 73 | expand the scale by 5\% on each side for continuous variables, and by 74 | 0.6 units on each side for discrete variables.} 75 | }} 76 | 77 | \item{range}{a numeric vector of length 2 that specifies the minimum and 78 | maximum size of the plotting symbol after transformation.} 79 | 80 | \item{midpoint}{the midpoint (in data value) of the diverging scale. Defaults to 0.} 81 | 82 | \item{guide}{A function used to create a guide or its name. See 83 | \code{\link[ggplot2:guides]{guides()}} for more info.} 84 | } 85 | \description{ 86 | Scale radius 87 | } 88 | -------------------------------------------------------------------------------- /man/text_params.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/add-link-extra-params.R 3 | \name{text_params} 4 | \alias{text_params} 5 | \title{Extra text label params} 6 | \usage{ 7 | text_params( 8 | colour = "black", 9 | size = 3.88, 10 | angle = 0, 11 | hjust = NULL, 12 | vjust = 0.5, 13 | alpha = NA, 14 | family = "", 15 | fontface = 1, 16 | color = NULL 17 | ) 18 | } 19 | \arguments{ 20 | \item{colour, color}{colour of text.} 21 | 22 | \item{size}{font size of text.} 23 | 24 | \item{angle}{angle to rotate the text.} 25 | 26 | \item{hjust, vjust}{a numeric vector specifying horizontal/vertical justification.} 27 | 28 | \item{alpha}{alpha channel for transparency.} 29 | 30 | \item{family}{the font family.} 31 | 32 | \item{fontface}{the font face.} 33 | } 34 | \description{ 35 | This is mainly used in the add_link function to set the group label. 36 | } 37 | \author{ 38 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 39 | } 40 | -------------------------------------------------------------------------------- /man/theme_cor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme-cor.R 3 | \name{theme_cor} 4 | \alias{theme_cor} 5 | \title{Create the default ggcor theme} 6 | \usage{ 7 | theme_cor(legend.position = "right", ...) 8 | } 9 | \arguments{ 10 | \item{legend.position}{the position of legends ("none", "left", "right", 11 | "bottom", "top", or two-element numeric vector).} 12 | 13 | \item{...}{extra params passing to \code{\link[ggplot2]{theme}}.} 14 | } 15 | \value{ 16 | The theme. 17 | } 18 | \description{ 19 | Create the default ggcor theme 20 | } 21 | \details{ 22 | The theme_cor, with no axis title, no background, no grid, 23 | made some adjustments to the x-axis label. 24 | } 25 | \examples{ 26 | require(ggplot2, quietly = TRUE) 27 | df <- fortify_cor(mtcars) 28 | ggcor(df) + geom_raster(aes(fill = r)) + theme_cor() 29 | } 30 | \author{ 31 | Houyun Huang, Lei Zhou, Jian Chen, Taiyun Wei 32 | } 33 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | 2 | # ggcor 3 | 4 | 5 | 6 | [![Lifecycle: 7 | experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental) 8 | 9 | 10 | The goal of `ggcor` is to to provide a set of functions that be used to 11 | visualize simply and directly a correlation matrix based on ‘ggplot2’. 12 | 13 | ## Installation 14 | 15 | Now `ggcor` is not on cran, You can install the development version of 16 | ggcor from [GitHub](https://github.com/) with: 17 | 18 | ``` r 19 | # install.packages("devtools") 20 | devtools::install_github("houyunhuang/ggcor") 21 | ``` 22 | 23 | ## Draw correlation plot quickly 24 | 25 | This is a basic example which shows you how to draw correlation plot 26 | quickly: 27 | 28 | ``` r 29 | library(ggplot2) 30 | library(ggcor) 31 | quickcor(mtcars) + geom_colour() 32 | ``` 33 | 34 | 35 | 36 | ``` r 37 | quickcor(mtcars, type = "upper") + geom_circle2() 38 | ``` 39 | 40 | 41 | 42 | ``` r 43 | quickcor(mtcars, cor.test = TRUE) + 44 | geom_square(data = get_data(type = "lower", show.diag = FALSE)) + 45 | geom_mark(data = get_data(type = "upper", show.diag = FALSE), size = 2.5) + 46 | geom_abline(slope = -1, intercept = 12) 47 | ``` 48 | 49 | 50 | 51 | ## Mantel test plot 52 | 53 | ``` r 54 | library(vegan) 55 | library(dplyr) 56 | data("varechem") 57 | data("varespec") 58 | set.seed(20191224) 59 | sam_grp <- sample(paste0("sample", 1:3), 24, replace = TRUE) 60 | mantel01 <- fortify_mantel(varespec, varechem, group = sam_grp, 61 | spec.select = list(spec01 = 1:5, 62 | spec02 = 6:12, 63 | spec03 = 7:18, 64 | spec04 = 20:29, 65 | spec05 = 30:44), 66 | mantel.fun = "mantel.randtest") 67 | quickcor(mantel01, legend.title = "Mantel's r") + 68 | geom_colour() + geom_cross() + facet_grid(rows = vars(.group)) 69 | ``` 70 | 71 | 72 | 73 | ``` r 74 | mantel02 <- fortify_mantel(varespec, varechem, 75 | spec.select = list(1:10, 5:14, 7:22, 9:32)) %>% 76 | mutate(r = cut(r, breaks = c(-Inf, 0.25, 0.5, Inf), 77 | labels = c("<0.25", "0.25-0.5", ">=0.5"), 78 | right = FALSE), 79 | p.value = cut(p.value, breaks = c(-Inf, 0.001, 0.01, 0.05, Inf), 80 | labels = c("<0.001", "0.001-0.01", "0.01-0.05", ">=0.05"), 81 | right = FALSE)) 82 | quickcor(varechem, type = "upper") + geom_square() + 83 | add_link(mantel02, mapping = aes(colour = p.value, size = r), 84 | diag.label = TRUE) + 85 | scale_size_manual(values = c(0.5, 1.5, 3)) + 86 | add_diag_label() + remove_axis("x") 87 | #> Warning: `add_diag_label()` is deprecated. Use `geom_diag_label()` instead. 88 | ``` 89 | 90 | 91 | 92 | # network 93 | 94 | ``` r 95 | library(tidygraph) 96 | library(ggraph) 97 | net <- fast_correlate(varespec) %>% 98 | as_tbl_graph(r.thres = 0.5, p.thres = 0.05) %>% 99 | mutate(degree = tidygraph::centrality_degree(mode = "all")) 100 | 101 | ggraph(net, "circle") + 102 | geom_edge_fan(aes(edge_width = r, edge_linetype = r < 0), 103 | edge_colour = "grey80", show.legend = FALSE) + 104 | geom_node_point(aes(size = degree, colour = name), 105 | show.legend = FALSE) + 106 | geom_node_text(aes(x = x * 1.08, y = y * 1.08, 107 | angle = -((-node_angle(x, y) + 90) %% 180) + 90, 108 | label = name), size = 4, hjust= "outward", 109 | show.legend = FALSE) + 110 | scale_edge_color_gradientn(colours = c("blue", "red")) + 111 | scale_edge_width_continuous(range = c(0.1, 1)) + 112 | coord_fixed(xlim = c(-1.5, 1.5), ylim = c(-1.5, 1.5)) + 113 | theme_graph() 114 | ``` 115 | 116 | 117 | 118 | # general heatmap 119 | 120 | ``` r 121 | mat <- matrix(rnorm(120), nrow = 15) 122 | cor_tbl(extra.mat = list(mat = mat)) %>% 123 | quickcor(mapping = aes(fill = mat)) + geom_colour() 124 | ``` 125 | 126 | 127 | 128 | # upper and lower with different geom 129 | 130 | ``` r 131 | d <- dist(t(mtcars)) 132 | correlate(mtcars, cor.test = TRUE) %>% 133 | as_cor_tbl(extra.mat = list(dist = d)) %>% 134 | quickcor() + 135 | geom_upper_square(aes(upper_fill = r, upper_r0 = r)) + 136 | geom_lower_colour(aes(lower_fill = dist)) + 137 | geom_diag_label() + 138 | remove_all_axis() 139 | ``` 140 | 141 | 142 | --------------------------------------------------------------------------------