Guangchuang Yu authored on 23/03/2022 04:13:34
| ... | ... |
@@ -31,6 +31,8 @@ |
| 31 | 31 |
##' @export |
| 32 | 32 |
##' @author Yu Guangchuang |
| 33 | 33 |
##' @examples |
| 34 |
+##' tree <- rtree(10) |
|
| 35 |
+##' ggplot(tree) + geom_tree() |
|
| 34 | 36 |
##' @references |
| 35 | 37 |
##' For demonstration of this function, please refer to chapter 4.2.1 of |
| 36 | 38 |
##' *Data Integration, Manipulation and Visualization of Phylogenetic Trees* |
| ... | ... |
@@ -3,10 +3,10 @@ |
| 3 | 3 |
##' |
| 4 | 4 |
##' @title geom_tree |
| 5 | 5 |
##' @param mapping aesthetic mapping |
| 6 |
-##' @param data data |
|
| 6 |
+##' @param data data of the tree |
|
| 7 | 7 |
##' @param layout one of 'rectangular', 'dendrogram', 'slanted', 'ellipse', 'roundrect', |
| 8 | 8 |
##' 'fan', 'circular', 'inward_circular', 'radial', 'equal_angle', 'daylight' or 'ape' |
| 9 |
-##' @param multiPhylo logical, whether input data contains multiple phylo class. |
|
| 9 |
+##' @param multiPhylo logical, whether input data contains multiple phylo class, defaults to "FALSE". |
|
| 10 | 10 |
##' @param continuous character, continuous transition for selected aesthethic ('size'
|
| 11 | 11 |
##' or 'color'('colour')). It should be one of 'color' (or 'colour'), 'size', 'all'
|
| 12 | 12 |
##' and 'none', default is 'none' |
| ... | ... |
@@ -30,6 +30,11 @@ |
| 30 | 30 |
##' @importFrom ggplot2 aes |
| 31 | 31 |
##' @export |
| 32 | 32 |
##' @author Yu Guangchuang |
| 33 |
+##' @examples |
|
| 34 |
+##' @references |
|
| 35 |
+##' For demonstration of this function, please refer to chapter 4.2.1 of |
|
| 36 |
+##' *Data Integration, Manipulation and Visualization of Phylogenetic Trees* |
|
| 37 |
+##' <http://yulab-smu.top/treedata-book/index.html> by Guangchuang Yu. |
|
| 33 | 38 |
geom_tree <- function(mapping=NULL, data=NULL, layout="rectangular", multiPhylo=FALSE, continuous="none", position="identity", ...) {
|
| 34 | 39 |
if (is.logical(continuous)){
|
| 35 | 40 |
warning_wrap('The type of "continuous" argument was changed (v>=2.5.2). Now,
|
Guangchuang Yu authored on 13/08/2021 15:31:49
• GitHub committed on 13/08/2021 15:31:49
| ... | ... |
@@ -104,7 +104,7 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit |
| 104 | 104 |
) |
| 105 | 105 |
) |
| 106 | 106 |
} else if (layout %in% c("slanted", "radial", "equal_angle", "daylight", "ape")) {
|
| 107 |
- line.type <- getOption(x="radial.line.type", default="straight") |
|
| 107 |
+ line.type <- getOption(x="layout.radial.linetype", default="straight") |
|
| 108 | 108 |
geom <- switch(line.type, straight=GeomSegmentGGtree, curved=geom) |
| 109 | 109 |
layer(stat=StatTree, |
| 110 | 110 |
data=data, |
xiangpin authored on 13/08/2021 13:45:40
| ... | ... |
@@ -104,10 +104,12 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit |
| 104 | 104 |
) |
| 105 | 105 |
) |
| 106 | 106 |
} else if (layout %in% c("slanted", "radial", "equal_angle", "daylight", "ape")) {
|
| 107 |
+ line.type <- getOption(x="radial.line.type", default="straight") |
|
| 108 |
+ geom <- switch(line.type, straight=GeomSegmentGGtree, curved=geom) |
|
| 107 | 109 |
layer(stat=StatTree, |
| 108 | 110 |
data=data, |
| 109 | 111 |
mapping=mapping, |
| 110 |
- geom = GeomSegmentGGtree, |
|
| 112 |
+ geom = geom, |
|
| 111 | 113 |
position=position, |
| 112 | 114 |
show.legend = show.legend, |
| 113 | 115 |
inherit.aes = inherit.aes, |
xiangpin authored on 10/08/2021 07:30:58
| ... | ... |
@@ -10,6 +10,8 @@ |
| 10 | 10 |
##' @param continuous character, continuous transition for selected aesthethic ('size'
|
| 11 | 11 |
##' or 'color'('colour')). It should be one of 'color' (or 'colour'), 'size', 'all'
|
| 12 | 12 |
##' and 'none', default is 'none' |
| 13 |
+##' @param position Position adjustment, either as a string, or the result of a |
|
| 14 |
+##' call to a position adjustment function, default is "identity". |
|
| 13 | 15 |
##' @param ... additional parameter |
| 14 | 16 |
##' |
| 15 | 17 |
##' some dot arguments: |
| ... | ... |
@@ -28,7 +30,7 @@ |
| 28 | 30 |
##' @importFrom ggplot2 aes |
| 29 | 31 |
##' @export |
| 30 | 32 |
##' @author Yu Guangchuang |
| 31 |
-geom_tree <- function(mapping=NULL, data=NULL, layout="rectangular", multiPhylo=FALSE, continuous="none", ...) {
|
|
| 33 |
+geom_tree <- function(mapping=NULL, data=NULL, layout="rectangular", multiPhylo=FALSE, continuous="none", position="identity", ...) {
|
|
| 32 | 34 |
if (is.logical(continuous)){
|
| 33 | 35 |
warning_wrap('The type of "continuous" argument was changed (v>=2.5.2). Now,
|
| 34 | 36 |
it should be one of "color" (or "colour"), "size", "all", and "none".') |
| ... | ... |
@@ -41,7 +43,7 @@ geom_tree <- function(mapping=NULL, data=NULL, layout="rectangular", multiPhylo= |
| 41 | 43 |
continuous <- ifelse(continuous, "color", "none") |
| 42 | 44 |
} |
| 43 | 45 |
continuous <- match.arg(continuous, c("color", "colour", "size", "none", "all"))
|
| 44 |
- stat_tree(data=data, mapping=mapping, geom="segment", |
|
| 46 |
+ stat_tree(data=data, mapping=mapping, geom="segment", position=position, |
|
| 45 | 47 |
layout=layout, multiPhylo=multiPhylo, continuous=continuous, ...) |
| 46 | 48 |
} |
| 47 | 49 |
|
xiangpin authored on 28/07/2021 05:24:47
| ... | ... |
@@ -105,7 +105,7 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit |
| 105 | 105 |
layer(stat=StatTree, |
| 106 | 106 |
data=data, |
| 107 | 107 |
mapping=mapping, |
| 108 |
- geom = geom, |
|
| 108 |
+ geom = GeomSegmentGGtree, |
|
| 109 | 109 |
position=position, |
| 110 | 110 |
show.legend = show.legend, |
| 111 | 111 |
inherit.aes = inherit.aes, |
xiangpin authored on 16/04/2021 04:07:50
| ... | ... |
@@ -363,7 +363,7 @@ StatTreeEllipse <- ggproto("StatTreeEllipse", Stat,
|
| 363 | 363 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 364 | 364 |
continuous = "none", nsplit = 100, |
| 365 | 365 |
extend = 0.002, rootnode = TRUE){
|
| 366 |
- if (continuous !="none" || continuous){
|
|
| 366 |
+ if (continuous !="none"){
|
|
| 367 | 367 |
stop("continuous colour or size are not implemented for roundrect or ellipse layout")
|
| 368 | 368 |
} |
| 369 | 369 |
df <- StatTree$compute_panel(data = data, scales = scales, |
xiangpin authored on 07/04/2021 08:16:32
| ... | ... |
@@ -7,12 +7,13 @@ |
| 7 | 7 |
##' @param layout one of 'rectangular', 'dendrogram', 'slanted', 'ellipse', 'roundrect', |
| 8 | 8 |
##' 'fan', 'circular', 'inward_circular', 'radial', 'equal_angle', 'daylight' or 'ape' |
| 9 | 9 |
##' @param multiPhylo logical, whether input data contains multiple phylo class. |
| 10 |
+##' @param continuous character, continuous transition for selected aesthethic ('size'
|
|
| 11 |
+##' or 'color'('colour')). It should be one of 'color' (or 'colour'), 'size', 'all'
|
|
| 12 |
+##' and 'none', default is 'none' |
|
| 10 | 13 |
##' @param ... additional parameter |
| 11 |
-##' |
|
| 14 |
+##' |
|
| 12 | 15 |
##' some dot arguments: |
| 13 | 16 |
##' \itemize{
|
| 14 |
-##' \item \code{continuous} character, continuous transition for selected aesthethic ('size' or 'color'('colour')). It
|
|
| 15 |
-##' should be one of 'color' (or 'colour'), 'size', 'all' and 'none', default is 'none'. |
|
| 16 | 17 |
##' \item \code{nsplit} integer, the number of branch blocks divided when 'continuous' is not "none", default is 200.
|
| 17 | 18 |
##' } |
| 18 | 19 |
##' @return tree layer |
| ... | ... |
@@ -27,16 +28,28 @@ |
| 27 | 28 |
##' @importFrom ggplot2 aes |
| 28 | 29 |
##' @export |
| 29 | 30 |
##' @author Yu Guangchuang |
| 30 |
-geom_tree <- function(mapping=NULL, data=NULL, layout="rectangular", multiPhylo=FALSE, ...) {
|
|
| 31 |
+geom_tree <- function(mapping=NULL, data=NULL, layout="rectangular", multiPhylo=FALSE, continuous="none", ...) {
|
|
| 32 |
+ if (is.logical(continuous)){
|
|
| 33 |
+ warning_wrap('The type of "continuous" argument was changed (v>=2.5.2). Now,
|
|
| 34 |
+ it should be one of "color" (or "colour"), "size", "all", and "none".') |
|
| 35 |
+ ifelse(continuous, |
|
| 36 |
+ warning_wrap('It was set to TRUE, it should be replaced with "color" (or "colour"),
|
|
| 37 |
+ this meaning the aesthethic of "color" (or "colour") is continuous.'), |
|
| 38 |
+ warning_wrap('It was set to FALSE, it should be replaced with "none",
|
|
| 39 |
+ this meaning the aesthethic of "color" (or "colour") or "size" will not be continuous.') |
|
| 40 |
+ ) |
|
| 41 |
+ continuous <- ifelse(continuous, "color", "none") |
|
| 42 |
+ } |
|
| 43 |
+ continuous <- match.arg(continuous, c("color", "colour", "size", "none", "all"))
|
|
| 31 | 44 |
stat_tree(data=data, mapping=mapping, geom="segment", |
| 32 |
- layout=layout, multiPhylo=multiPhylo, ...) |
|
| 45 |
+ layout=layout, multiPhylo=multiPhylo, continuous=continuous, ...) |
|
| 33 | 46 |
} |
| 34 | 47 |
|
| 35 | 48 |
|
| 36 | 49 |
stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identity", |
| 37 | 50 |
layout="rectangular", multiPhylo=FALSE, lineend="round", MAX_COUNT=5, |
| 38 | 51 |
..., arrow=NULL, rootnode=TRUE, show.legend=NA, inherit.aes=TRUE, |
| 39 |
- na.rm=TRUE, check.param=TRUE) {
|
|
| 52 |
+ na.rm=TRUE, check.param=TRUE, continuous="none") {
|
|
| 40 | 53 |
|
| 41 | 54 |
default_aes <- aes_(x=~x, y=~y,node=~node, parent=~parent) |
| 42 | 55 |
if (multiPhylo) {
|
| ... | ... |
@@ -67,6 +80,7 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit |
| 67 | 80 |
na.rm = na.rm, |
| 68 | 81 |
arrow = arrow, |
| 69 | 82 |
rootnode = rootnode, |
| 83 |
+ continuous = continuous, |
|
| 70 | 84 |
...), |
| 71 | 85 |
check.aes = FALSE |
| 72 | 86 |
), |
| ... | ... |
@@ -82,6 +96,7 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit |
| 82 | 96 |
na.rm = na.rm, |
| 83 | 97 |
## arrow = arrow, |
| 84 | 98 |
rootnode = rootnode, |
| 99 |
+ continuous = continuous, |
|
| 85 | 100 |
...), |
| 86 | 101 |
check.aes = FALSE |
| 87 | 102 |
) |
| ... | ... |
@@ -99,6 +114,7 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit |
| 99 | 114 |
na.rm = na.rm, |
| 100 | 115 |
arrow = arrow, |
| 101 | 116 |
rootnode = rootnode, |
| 117 |
+ continuous = continuous, |
|
| 102 | 118 |
...), |
| 103 | 119 |
check.aes = FALSE |
| 104 | 120 |
) |
| ... | ... |
@@ -116,6 +132,7 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit |
| 116 | 132 |
na.rm = na.rm, |
| 117 | 133 |
arrow = arrow, |
| 118 | 134 |
rootnode = rootnode, |
| 135 |
+ continuous = continuous, |
|
| 119 | 136 |
...), |
| 120 | 137 |
check.aes=FALSE |
| 121 | 138 |
) |
| ... | ... |
@@ -156,15 +173,6 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 156 | 173 |
|
| 157 | 174 |
df <- dplyr::filter(df, .data$node != tidytree:::rootnode.tbl_tree(df)$node) |
| 158 | 175 |
} |
| 159 |
- if (is.logical(continuous)){
|
|
| 160 |
- warning_wrap('The continuous argument type was changed (v>=2.5.2). Now, it should be one of "color"(or "colour"), "size", "all", and "none".')
|
|
| 161 |
- ifelse(continuous, |
|
| 162 |
- warning_wrap('It was set to TRUE, it should be replaced with "color"(or "colour"), this meaning the aesthethic of "color"(or "colour") is continuous.'),
|
|
| 163 |
- warning_wrap('It was set to FALSE, it should be replaced with "none", this meaning the aesthethic of "color"(or "colour") or "size" will not be continuous.')
|
|
| 164 |
- ) |
|
| 165 |
- continuous <- ifelse(continuous, "color", "none") |
|
| 166 |
- } |
|
| 167 |
- continuous <- match.arg(continuous, c("color", "colour", "size", "none", "all"))
|
|
| 168 | 176 |
if (continuous != "none") {
|
| 169 | 177 |
# using ggnewscale new_scale("color") for multiple color scales
|
| 170 | 178 |
if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
| ... | ... |
@@ -233,10 +241,6 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 233 | 241 |
df <- dplyr::filter(df, .data$node != rootnode.tbl_tree(df)$node) |
| 234 | 242 |
} |
| 235 | 243 |
|
| 236 |
- if (is.logical(continuous)){
|
|
| 237 |
- continuous <- ifelse(continuous, "color", "none") |
|
| 238 |
- } |
|
| 239 |
- |
|
| 240 | 244 |
if (continuous != "none"){
|
| 241 | 245 |
# using ggnewscale new_scale("color") for multiple color scales
|
| 242 | 246 |
if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
| ... | ... |
@@ -303,15 +307,6 @@ StatTree <- ggproto("StatTree", Stat,
|
| 303 | 307 |
if (!rootnode) {
|
| 304 | 308 |
df <- dplyr::filter(df, .data$node != rootnode.tbl_tree(df)$node) |
| 305 | 309 |
} |
| 306 |
- if (is.logical(continuous)){
|
|
| 307 |
- warning_wrap('The continuous argument type was changed (v>=2.5.2). Now, it should be one of "color" (or "colour"), "size", "all", and "none".')
|
|
| 308 |
- ifelse(continuous, |
|
| 309 |
- warning_wrap('It was set to TRUE, it should be replaced with "color" (or "colour"), this meaning the aesthethic of "color" (or "colour") is continuous.'),
|
|
| 310 |
- warning_wrap('It was set to FALSE, it should be replaced with "none", this meaning the aesthethic of "color" (or "colour") or "size" will not be continuous.')
|
|
| 311 |
- ) |
|
| 312 |
- continuous <- ifelse(continuous, "color", "none") |
|
| 313 |
- } |
|
| 314 |
- continuous <- match.arg(continuous, c("color", "colour", "size", "none", "all"))
|
|
| 315 | 310 |
if (continuous != "none") {
|
| 316 | 311 |
# using ggnewscale new_scale("color") for multiple color scales
|
| 317 | 312 |
if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
Guangchuang Yu authored on 07/04/2021 02:49:27
• GitHub committed on 07/04/2021 02:49:27
| ... | ... |
@@ -11,7 +11,7 @@ |
| 11 | 11 |
##' |
| 12 | 12 |
##' some dot arguments: |
| 13 | 13 |
##' \itemize{
|
| 14 |
-##' \item \code{continuous} a character, which the aesthethic ('size' or 'color'('colour')) will be continuous. It
|
|
| 14 |
+##' \item \code{continuous} character, continuous transition for selected aesthethic ('size' or 'color'('colour')). It
|
|
| 15 | 15 |
##' should be one of 'color' (or 'colour'), 'size', 'all' and 'none', default is 'none'. |
| 16 | 16 |
##' \item \code{nsplit} integer, the number of branch blocks divided when 'continuous' is not "none", default is 200.
|
| 17 | 17 |
##' } |
xiangpin authored on 06/04/2021 12:33:52
| ... | ... |
@@ -11,18 +11,17 @@ |
| 11 | 11 |
##' |
| 12 | 12 |
##' some dot arguments: |
| 13 | 13 |
##' \itemize{
|
| 14 |
-##' \item \code{continuous} a character, which the aesthethic (`size` or `colour`) will be continuous. It
|
|
| 15 |
-##' should be one of 'color', 'size', 'all' and 'NULL', default is NULL. |
|
| 16 |
-##' \item \code{nsplit} integer, the number of branch blocks divided when `continuous` is not NULL, default is 200.
|
|
| 17 |
-##' default is TRUE, which is useful to 'aes(size=I(variable))'. |
|
| 14 |
+##' \item \code{continuous} a character, which the aesthethic ('size' or 'color'('colour')) will be continuous. It
|
|
| 15 |
+##' should be one of 'color' (or 'colour'), 'size', 'all' and 'none', default is 'none'. |
|
| 16 |
+##' \item \code{nsplit} integer, the number of branch blocks divided when 'continuous' is not "none", default is 200.
|
|
| 18 | 17 |
##' } |
| 19 | 18 |
##' @return tree layer |
| 20 | 19 |
##' @section Aesthetics: |
| 21 | 20 |
#' \code{geom_tree()} understands the following aesthethics:
|
| 22 | 21 |
##' \itemize{
|
| 23 |
-##' \item \code{colour} logical, control the color of line, default is black.
|
|
| 22 |
+##' \item \code{color} character, control the color of line, default is black (\code{continuous} is "none").
|
|
| 24 | 23 |
##' \item \code{linetype} control the type of line, default is 1 (solid).
|
| 25 |
-##' \item \code{size} numeric, control the width of line, default is 0.5.
|
|
| 24 |
+##' \item \code{size} numeric, control the width of line, default is 0.5 (\code{continuous} is "none").
|
|
| 26 | 25 |
##' } |
| 27 | 26 |
##' @importFrom ggplot2 geom_segment |
| 28 | 27 |
##' @importFrom ggplot2 aes |
| ... | ... |
@@ -137,7 +136,7 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 137 | 136 |
data |
| 138 | 137 |
}, |
| 139 | 138 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 140 |
- continuous = NULL, rootnode = TRUE, |
|
| 139 |
+ continuous = "none", rootnode = TRUE, |
|
| 141 | 140 |
nsplit = 100, extend=0.002 ) {
|
| 142 | 141 |
.fun <- function(data) {
|
| 143 | 142 |
df <- setup_tree_data(data) |
| ... | ... |
@@ -158,13 +157,15 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 158 | 157 |
df <- dplyr::filter(df, .data$node != tidytree:::rootnode.tbl_tree(df)$node) |
| 159 | 158 |
} |
| 160 | 159 |
if (is.logical(continuous)){
|
| 161 |
- warning_wrap('The continuous argument type was changed. Now, it should be one of "colour", "size", "all", and "NULL".')
|
|
| 162 |
- ifelse(continuous, warning_wrap('It was set to TRUE, it should be replaced with "colour", this meaning the aesthethic of "colour" is continuous.'),
|
|
| 163 |
- warning_wrap('It was set to FALSE, it should be replaced with "NULL", this meaning the aesthethic of "colour" or "size" will not be
|
|
| 164 |
- continuous.')) |
|
| 165 |
- continuous <- switch(continuous, "colour", NULL) |
|
| 166 |
- } |
|
| 167 |
- if (!is.null(continuous)) {
|
|
| 160 |
+ warning_wrap('The continuous argument type was changed (v>=2.5.2). Now, it should be one of "color"(or "colour"), "size", "all", and "none".')
|
|
| 161 |
+ ifelse(continuous, |
|
| 162 |
+ warning_wrap('It was set to TRUE, it should be replaced with "color"(or "colour"), this meaning the aesthethic of "color"(or "colour") is continuous.'),
|
|
| 163 |
+ warning_wrap('It was set to FALSE, it should be replaced with "none", this meaning the aesthethic of "color"(or "colour") or "size" will not be continuous.')
|
|
| 164 |
+ ) |
|
| 165 |
+ continuous <- ifelse(continuous, "color", "none") |
|
| 166 |
+ } |
|
| 167 |
+ continuous <- match.arg(continuous, c("color", "colour", "size", "none", "all"))
|
|
| 168 |
+ if (continuous != "none") {
|
|
| 168 | 169 |
# using ggnewscale new_scale("color") for multiple color scales
|
| 169 | 170 |
if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
| 170 | 171 |
names(df)[grep("colour_new", names(df))] <- "colour"
|
| ... | ... |
@@ -199,10 +200,10 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 199 | 200 |
df <- .fun(data) |
| 200 | 201 |
} |
| 201 | 202 |
# using ggnewscale new_scale for multiple color or size scales |
| 202 |
- if (length(grep("colour_new", names(data)))==1 && !is.null(continuous)){
|
|
| 203 |
+ if (length(grep("colour_new", names(data)))==1 && continuous != "none"){
|
|
| 203 | 204 |
names(df)[match("colour", names(df))] <- names(data)[grep("colour_new", names(data))]
|
| 204 | 205 |
} |
| 205 |
- if (length(grep("size_new", names(data)))==1 && !is.null(continuous)){
|
|
| 206 |
+ if (length(grep("size_new", names(data)))==1 && continuous != "none"){
|
|
| 206 | 207 |
names(df)[match("size", names(df))] <- names(data)[grep("size_new", names(data))]
|
| 207 | 208 |
} |
| 208 | 209 |
return(df) |
| ... | ... |
@@ -216,7 +217,7 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 216 | 217 |
data |
| 217 | 218 |
}, |
| 218 | 219 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 219 |
- continuous = NULL, nsplit=100, |
|
| 220 |
+ continuous = "none", nsplit=100, |
|
| 220 | 221 |
extend=0.002, rootnode = TRUE) {
|
| 221 | 222 |
.fun <- function(data) {
|
| 222 | 223 |
df <- setup_tree_data(data) |
| ... | ... |
@@ -233,10 +234,10 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 233 | 234 |
} |
| 234 | 235 |
|
| 235 | 236 |
if (is.logical(continuous)){
|
| 236 |
- continuous <- switch(continuous, "colour", NULL) |
|
| 237 |
+ continuous <- ifelse(continuous, "color", "none") |
|
| 237 | 238 |
} |
| 238 | 239 |
|
| 239 |
- if (!is.null(continuous)){
|
|
| 240 |
+ if (continuous != "none"){
|
|
| 240 | 241 |
# using ggnewscale new_scale("color") for multiple color scales
|
| 241 | 242 |
if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
| 242 | 243 |
names(df)[grep("colour_new", names(df))] <- "colour"
|
| ... | ... |
@@ -269,10 +270,10 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 269 | 270 |
} |
| 270 | 271 |
|
| 271 | 272 |
# using ggnewscale new_scale for multiple color or size scales |
| 272 |
- if (length(grep("colour_new", names(data)))==1 && !is.null(continuous)){
|
|
| 273 |
+ if (length(grep("colour_new", names(data)))==1 && continuous != "none"){
|
|
| 273 | 274 |
names(df)[match("colour", names(df))] <- names(data)[grep("colour_new", names(data))]
|
| 274 | 275 |
} |
| 275 |
- if (length(grep("size_new", names(data)))==1 && !is.null(continuous)){
|
|
| 276 |
+ if (length(grep("size_new", names(data)))==1 && continuous != "none"){
|
|
| 276 | 277 |
names(df)[match("size", names(df))] <- names(data)[grep("size_new", names(data))]
|
| 277 | 278 |
} |
| 278 | 279 |
return(df) |
| ... | ... |
@@ -287,7 +288,7 @@ StatTree <- ggproto("StatTree", Stat,
|
| 287 | 288 |
data |
| 288 | 289 |
}, |
| 289 | 290 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 290 |
- continuous = NULL, nsplit = 100, |
|
| 291 |
+ continuous = "none", nsplit = 100, |
|
| 291 | 292 |
extend = 0.002, rootnode = TRUE) {
|
| 292 | 293 |
.fun <- function(data) {
|
| 293 | 294 |
df <- setup_tree_data(data) |
| ... | ... |
@@ -303,15 +304,15 @@ StatTree <- ggproto("StatTree", Stat,
|
| 303 | 304 |
df <- dplyr::filter(df, .data$node != rootnode.tbl_tree(df)$node) |
| 304 | 305 |
} |
| 305 | 306 |
if (is.logical(continuous)){
|
| 306 |
- warning_wrap('The continuous argument type was changed. Now, it should be one of "colour", "size", "all", and "NULL".')
|
|
| 307 |
+ warning_wrap('The continuous argument type was changed (v>=2.5.2). Now, it should be one of "color" (or "colour"), "size", "all", and "none".')
|
|
| 307 | 308 |
ifelse(continuous, |
| 308 |
- warning_wrap('It was set to TRUE, it should be replaced with "colour", this meaning the aesthethic of "colour" is continuous.'),
|
|
| 309 |
- warning_wrap('It was set to FALSE, it should be replaced with "NULL", this meaning the aesthethic of "colour" or "size" will not be
|
|
| 310 |
- continuous.')) |
|
| 311 |
- continuous <- switch(continuous, "colour", NULL) |
|
| 309 |
+ warning_wrap('It was set to TRUE, it should be replaced with "color" (or "colour"), this meaning the aesthethic of "color" (or "colour") is continuous.'),
|
|
| 310 |
+ warning_wrap('It was set to FALSE, it should be replaced with "none", this meaning the aesthethic of "color" (or "colour") or "size" will not be continuous.')
|
|
| 311 |
+ ) |
|
| 312 |
+ continuous <- ifelse(continuous, "color", "none") |
|
| 312 | 313 |
} |
| 313 |
- |
|
| 314 |
- if (!is.null(continuous)) {
|
|
| 314 |
+ continuous <- match.arg(continuous, c("color", "colour", "size", "none", "all"))
|
|
| 315 |
+ if (continuous != "none") {
|
|
| 315 | 316 |
# using ggnewscale new_scale("color") for multiple color scales
|
| 316 | 317 |
if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
| 317 | 318 |
names(df)[grep("colour_new", names(df))] <- "colour"
|
| ... | ... |
@@ -347,10 +348,10 @@ StatTree <- ggproto("StatTree", Stat,
|
| 347 | 348 |
} |
| 348 | 349 |
|
| 349 | 350 |
# using ggnewscale new_scale for multiple color or size scales |
| 350 |
- if (length(grep("colour_new", names(data)))==1 && !is.null(continuous)){
|
|
| 351 |
+ if (length(grep("colour_new", names(data)))==1 && continuous != "none"){
|
|
| 351 | 352 |
names(df)[match("colour", names(df))] <- names(data)[grep("colour_new", names(data))]
|
| 352 | 353 |
} |
| 353 |
- if (length(grep("size_new", names(data)))==1 && !is.null(continuous)){
|
|
| 354 |
+ if (length(grep("size_new", names(data)))==1 && continuous != "none"){
|
|
| 354 | 355 |
names(df)[match("size", names(df))] <- names(data)[grep("size_new", names(data))]
|
| 355 | 356 |
} |
| 356 | 357 |
|
| ... | ... |
@@ -365,9 +366,9 @@ StatTreeEllipse <- ggproto("StatTreeEllipse", Stat,
|
| 365 | 366 |
data |
| 366 | 367 |
}, |
| 367 | 368 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 368 |
- continuous = NULL, nsplit = 100, |
|
| 369 |
+ continuous = "none", nsplit = 100, |
|
| 369 | 370 |
extend = 0.002, rootnode = TRUE){
|
| 370 |
- if (!is.null(continuous) || continuous){
|
|
| 371 |
+ if (continuous !="none" || continuous){
|
|
| 371 | 372 |
stop("continuous colour or size are not implemented for roundrect or ellipse layout")
|
| 372 | 373 |
} |
| 373 | 374 |
df <- StatTree$compute_panel(data = data, scales = scales, |
| ... | ... |
@@ -506,13 +507,13 @@ setup_data_continuous_color_size_tree <- function(df, nsplit = 100, extend = 0.0 |
| 506 | 507 |
extend = extend) |
| 507 | 508 |
df2$node <- df$node[i] |
| 508 | 509 |
# for aes(size=I(variable)) etc. |
| 509 |
- if (continuous %in% c("color", "colour", "Color", "Colour")){
|
|
| 510 |
+ if (continuous %in% c("color", "colour")){
|
|
| 510 | 511 |
j <- match(c('x', 'xend', 'y', 'yend', 'col', 'col2', 'colour', 'size1', 'size2'), colnames(df))
|
| 511 | 512 |
df2$size <- NULL |
| 512 |
- }else if (continuous %in% c("size", "Size")){
|
|
| 513 |
+ }else if (continuous == "size"){
|
|
| 513 | 514 |
j <- match(c("x", "xend", "y", "yend", "col", "col2", "size1", "size2", "size"), colnames(df))
|
| 514 | 515 |
df2$colour <- NULL |
| 515 |
- }else if (continuous %in% c("all", "All", "ALL")){
|
|
| 516 |
+ }else if (continuous == "all"){
|
|
| 516 | 517 |
j <- match(c('x', 'xend', 'y', 'yend', 'col', 'col2', 'colour', 'size1', 'size2', 'size'), colnames(df))
|
| 517 | 518 |
} |
| 518 | 519 |
j <- j[!is.na(j)] |
xiangpin authored on 03/04/2021 15:22:30
| ... | ... |
@@ -11,9 +11,9 @@ |
| 11 | 11 |
##' |
| 12 | 12 |
##' some dot arguments: |
| 13 | 13 |
##' \itemize{
|
| 14 |
-##' \item \code{continuous} logical, whether the aesthethic of `size` or `color` is continuous, default is FALSE.
|
|
| 15 |
-##' \item \code{nsplit} integer, the number of branch blocks divided when `continuous` is TRUE, default is 200.
|
|
| 16 |
-##' \item \code{inhibit.size} logical, whether inhibit the size when it was mapped to a variable in aesthetic and item \code{continuous} is TRUE,
|
|
| 14 |
+##' \item \code{continuous} a character, which the aesthethic (`size` or `colour`) will be continuous. It
|
|
| 15 |
+##' should be one of 'color', 'size', 'all' and 'NULL', default is NULL. |
|
| 16 |
+##' \item \code{nsplit} integer, the number of branch blocks divided when `continuous` is not NULL, default is 200.
|
|
| 17 | 17 |
##' default is TRUE, which is useful to 'aes(size=I(variable))'. |
| 18 | 18 |
##' } |
| 19 | 19 |
##' @return tree layer |
| ... | ... |
@@ -137,8 +137,8 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 137 | 137 |
data |
| 138 | 138 |
}, |
| 139 | 139 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 140 |
- continuous = FALSE, rootnode = TRUE, |
|
| 141 |
- nsplit = 100, extend=0.002, inhibit.size = TRUE) {
|
|
| 140 |
+ continuous = NULL, rootnode = TRUE, |
|
| 141 |
+ nsplit = 100, extend=0.002 ) {
|
|
| 142 | 142 |
.fun <- function(data) {
|
| 143 | 143 |
df <- setup_tree_data(data) |
| 144 | 144 |
x <- df$x |
| ... | ... |
@@ -157,8 +157,14 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 157 | 157 |
|
| 158 | 158 |
df <- dplyr::filter(df, .data$node != tidytree:::rootnode.tbl_tree(df)$node) |
| 159 | 159 |
} |
| 160 |
- |
|
| 161 |
- if (continuous) {
|
|
| 160 |
+ if (is.logical(continuous)){
|
|
| 161 |
+ warning_wrap('The continuous argument type was changed. Now, it should be one of "colour", "size", "all", and "NULL".')
|
|
| 162 |
+ ifelse(continuous, warning_wrap('It was set to TRUE, it should be replaced with "colour", this meaning the aesthethic of "colour" is continuous.'),
|
|
| 163 |
+ warning_wrap('It was set to FALSE, it should be replaced with "NULL", this meaning the aesthethic of "colour" or "size" will not be
|
|
| 164 |
+ continuous.')) |
|
| 165 |
+ continuous <- switch(continuous, "colour", NULL) |
|
| 166 |
+ } |
|
| 167 |
+ if (!is.null(continuous)) {
|
|
| 162 | 168 |
# using ggnewscale new_scale("color") for multiple color scales
|
| 163 | 169 |
if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
| 164 | 170 |
names(df)[grep("colour_new", names(df))] <- "colour"
|
| ... | ... |
@@ -181,24 +187,22 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 181 | 187 |
df$size2 <- df$size |
| 182 | 188 |
df$size1 <- df$size2[ii] |
| 183 | 189 |
} |
| 184 |
- setup_data_continuous_color_size_tree(df, nsplit = nsplit, extend = extend, inhibit.size = inhibit.size) |
|
| 190 |
+ setup_data_continuous_color_size_tree(df, nsplit = nsplit, extend = extend, continuous = continuous) |
|
| 185 | 191 |
} else {
|
| 186 | 192 |
return(df) |
| 187 | 193 |
} |
| 188 | 194 |
} |
| 189 |
- |
|
| 190 | 195 |
if ('.id' %in% names(data)) {
|
| 191 | 196 |
ldf <- split(data, data$.id) |
| 192 | 197 |
df <- do.call(rbind, lapply(ldf, .fun)) |
| 193 | 198 |
} else {
|
| 194 | 199 |
df <- .fun(data) |
| 195 | 200 |
} |
| 196 |
- |
|
| 197 | 201 |
# using ggnewscale new_scale for multiple color or size scales |
| 198 |
- if (length(grep("colour_new", names(data)))==1 && continuous){
|
|
| 202 |
+ if (length(grep("colour_new", names(data)))==1 && !is.null(continuous)){
|
|
| 199 | 203 |
names(df)[match("colour", names(df))] <- names(data)[grep("colour_new", names(data))]
|
| 200 | 204 |
} |
| 201 |
- if (length(grep("size_new", names(data)))==1 && continuous){
|
|
| 205 |
+ if (length(grep("size_new", names(data)))==1 && !is.null(continuous)){
|
|
| 202 | 206 |
names(df)[match("size", names(df))] <- names(data)[grep("size_new", names(data))]
|
| 203 | 207 |
} |
| 204 | 208 |
return(df) |
| ... | ... |
@@ -212,8 +216,8 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 212 | 216 |
data |
| 213 | 217 |
}, |
| 214 | 218 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 215 |
- continuous = FALSE, nsplit=100, |
|
| 216 |
- extend=0.002, rootnode = TRUE, inhibit.size = TRUE) {
|
|
| 219 |
+ continuous = NULL, nsplit=100, |
|
| 220 |
+ extend=0.002, rootnode = TRUE) {
|
|
| 217 | 221 |
.fun <- function(data) {
|
| 218 | 222 |
df <- setup_tree_data(data) |
| 219 | 223 |
x <- df$x |
| ... | ... |
@@ -228,7 +232,11 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 228 | 232 |
df <- dplyr::filter(df, .data$node != rootnode.tbl_tree(df)$node) |
| 229 | 233 |
} |
| 230 | 234 |
|
| 231 |
- if (continuous){
|
|
| 235 |
+ if (is.logical(continuous)){
|
|
| 236 |
+ continuous <- switch(continuous, "colour", NULL) |
|
| 237 |
+ } |
|
| 238 |
+ |
|
| 239 |
+ if (!is.null(continuous)){
|
|
| 232 | 240 |
# using ggnewscale new_scale("color") for multiple color scales
|
| 233 | 241 |
if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
| 234 | 242 |
names(df)[grep("colour_new", names(df))] <- "colour"
|
| ... | ... |
@@ -261,10 +269,10 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 261 | 269 |
} |
| 262 | 270 |
|
| 263 | 271 |
# using ggnewscale new_scale for multiple color or size scales |
| 264 |
- if (length(grep("colour_new", names(data)))==1 && continuous){
|
|
| 272 |
+ if (length(grep("colour_new", names(data)))==1 && !is.null(continuous)){
|
|
| 265 | 273 |
names(df)[match("colour", names(df))] <- names(data)[grep("colour_new", names(data))]
|
| 266 | 274 |
} |
| 267 |
- if (length(grep("size_new", names(data)))==1 && continuous){
|
|
| 275 |
+ if (length(grep("size_new", names(data)))==1 && !is.null(continuous)){
|
|
| 268 | 276 |
names(df)[match("size", names(df))] <- names(data)[grep("size_new", names(data))]
|
| 269 | 277 |
} |
| 270 | 278 |
return(df) |
| ... | ... |
@@ -279,8 +287,8 @@ StatTree <- ggproto("StatTree", Stat,
|
| 279 | 287 |
data |
| 280 | 288 |
}, |
| 281 | 289 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 282 |
- continuous = FALSE, nsplit = 100, |
|
| 283 |
- extend = 0.002, rootnode = TRUE, inhibit.size = TRUE) {
|
|
| 290 |
+ continuous = NULL, nsplit = 100, |
|
| 291 |
+ extend = 0.002, rootnode = TRUE) {
|
|
| 284 | 292 |
.fun <- function(data) {
|
| 285 | 293 |
df <- setup_tree_data(data) |
| 286 | 294 |
x <- df$x |
| ... | ... |
@@ -294,8 +302,16 @@ StatTree <- ggproto("StatTree", Stat,
|
| 294 | 302 |
if (!rootnode) {
|
| 295 | 303 |
df <- dplyr::filter(df, .data$node != rootnode.tbl_tree(df)$node) |
| 296 | 304 |
} |
| 305 |
+ if (is.logical(continuous)){
|
|
| 306 |
+ warning_wrap('The continuous argument type was changed. Now, it should be one of "colour", "size", "all", and "NULL".')
|
|
| 307 |
+ ifelse(continuous, |
|
| 308 |
+ warning_wrap('It was set to TRUE, it should be replaced with "colour", this meaning the aesthethic of "colour" is continuous.'),
|
|
| 309 |
+ warning_wrap('It was set to FALSE, it should be replaced with "NULL", this meaning the aesthethic of "colour" or "size" will not be
|
|
| 310 |
+ continuous.')) |
|
| 311 |
+ continuous <- switch(continuous, "colour", NULL) |
|
| 312 |
+ } |
|
| 297 | 313 |
|
| 298 |
- if (continuous) {
|
|
| 314 |
+ if (!is.null(continuous)) {
|
|
| 299 | 315 |
# using ggnewscale new_scale("color") for multiple color scales
|
| 300 | 316 |
if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
| 301 | 317 |
names(df)[grep("colour_new", names(df))] <- "colour"
|
| ... | ... |
@@ -318,7 +334,7 @@ StatTree <- ggproto("StatTree", Stat,
|
| 318 | 334 |
df$size2 <- df$size |
| 319 | 335 |
df$size1 <- df$size2[ii] |
| 320 | 336 |
} |
| 321 |
- setup_data_continuous_color_size_tree(df, nsplit = nsplit, extend = extend, inhibit.size = inhibit.size) |
|
| 337 |
+ setup_data_continuous_color_size_tree(df, nsplit = nsplit, extend = extend, continuous = continuous) |
|
| 322 | 338 |
} else{
|
| 323 | 339 |
return(df) |
| 324 | 340 |
} |
| ... | ... |
@@ -331,10 +347,10 @@ StatTree <- ggproto("StatTree", Stat,
|
| 331 | 347 |
} |
| 332 | 348 |
|
| 333 | 349 |
# using ggnewscale new_scale for multiple color or size scales |
| 334 |
- if (length(grep("colour_new", names(data)))==1 && continuous){
|
|
| 350 |
+ if (length(grep("colour_new", names(data)))==1 && !is.null(continuous)){
|
|
| 335 | 351 |
names(df)[match("colour", names(df))] <- names(data)[grep("colour_new", names(data))]
|
| 336 | 352 |
} |
| 337 |
- if (length(grep("size_new", names(data)))==1 && continuous){
|
|
| 353 |
+ if (length(grep("size_new", names(data)))==1 && !is.null(continuous)){
|
|
| 338 | 354 |
names(df)[match("size", names(df))] <- names(data)[grep("size_new", names(data))]
|
| 339 | 355 |
} |
| 340 | 356 |
|
| ... | ... |
@@ -349,9 +365,9 @@ StatTreeEllipse <- ggproto("StatTreeEllipse", Stat,
|
| 349 | 365 |
data |
| 350 | 366 |
}, |
| 351 | 367 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 352 |
- continuous = FALSE, nsplit = 100, |
|
| 368 |
+ continuous = NULL, nsplit = 100, |
|
| 353 | 369 |
extend = 0.002, rootnode = TRUE){
|
| 354 |
- if (continuous){
|
|
| 370 |
+ if (!is.null(continuous) || continuous){
|
|
| 355 | 371 |
stop("continuous colour or size are not implemented for roundrect or ellipse layout")
|
| 356 | 372 |
} |
| 357 | 373 |
df <- StatTree$compute_panel(data = data, scales = scales, |
| ... | ... |
@@ -475,7 +491,7 @@ setup_data_continuous_color_size <- function(x, xend, y, yend, col, col2, size1, |
| 475 | 491 |
return(dat) |
| 476 | 492 |
} |
| 477 | 493 |
|
| 478 |
-setup_data_continuous_color_size_tree <- function(df, nsplit = 100, extend = 0.002, inhibit.size=TRUE) {
|
|
| 494 |
+setup_data_continuous_color_size_tree <- function(df, nsplit = 100, extend = 0.002, continuous = "colour") {
|
|
| 479 | 495 |
lapply(1:nrow(df), function(i) {
|
| 480 | 496 |
df2 <- setup_data_continuous_color_size(x = df$x[i], |
| 481 | 497 |
xend = df$xend[i], |
| ... | ... |
@@ -490,10 +506,13 @@ setup_data_continuous_color_size_tree <- function(df, nsplit = 100, extend = 0.0 |
| 490 | 506 |
extend = extend) |
| 491 | 507 |
df2$node <- df$node[i] |
| 492 | 508 |
# for aes(size=I(variable)) etc. |
| 493 |
- if (inhibit.size){
|
|
| 509 |
+ if (continuous %in% c("color", "colour", "Color", "Colour")){
|
|
| 494 | 510 |
j <- match(c('x', 'xend', 'y', 'yend', 'col', 'col2', 'colour', 'size1', 'size2'), colnames(df))
|
| 495 | 511 |
df2$size <- NULL |
| 496 |
- }else{
|
|
| 512 |
+ }else if (continuous %in% c("size", "Size")){
|
|
| 513 |
+ j <- match(c("x", "xend", "y", "yend", "col", "col2", "size1", "size2", "size"), colnames(df))
|
|
| 514 |
+ df2$colour <- NULL |
|
| 515 |
+ }else if (continuous %in% c("all", "All", "ALL")){
|
|
| 497 | 516 |
j <- match(c('x', 'xend', 'y', 'yend', 'col', 'col2', 'colour', 'size1', 'size2', 'size'), colnames(df))
|
| 498 | 517 |
} |
| 499 | 518 |
j <- j[!is.na(j)] |
xiangpin authored on 29/03/2021 11:09:59
| ... | ... |
@@ -489,6 +489,7 @@ setup_data_continuous_color_size_tree <- function(df, nsplit = 100, extend = 0.0 |
| 489 | 489 |
nsplit = nsplit, |
| 490 | 490 |
extend = extend) |
| 491 | 491 |
df2$node <- df$node[i] |
| 492 |
+ # for aes(size=I(variable)) etc. |
|
| 492 | 493 |
if (inhibit.size){
|
| 493 | 494 |
j <- match(c('x', 'xend', 'y', 'yend', 'col', 'col2', 'colour', 'size1', 'size2'), colnames(df))
|
| 494 | 495 |
df2$size <- NULL |
xiangpin authored on 29/03/2021 11:07:38
| ... | ... |
@@ -13,6 +13,8 @@ |
| 13 | 13 |
##' \itemize{
|
| 14 | 14 |
##' \item \code{continuous} logical, whether the aesthethic of `size` or `color` is continuous, default is FALSE.
|
| 15 | 15 |
##' \item \code{nsplit} integer, the number of branch blocks divided when `continuous` is TRUE, default is 200.
|
| 16 |
+##' \item \code{inhibit.size} logical, whether inhibit the size when it was mapped to a variable in aesthetic and item \code{continuous} is TRUE,
|
|
| 17 |
+##' default is TRUE, which is useful to 'aes(size=I(variable))'. |
|
| 16 | 18 |
##' } |
| 17 | 19 |
##' @return tree layer |
| 18 | 20 |
##' @section Aesthetics: |
| ... | ... |
@@ -136,7 +138,7 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 136 | 138 |
}, |
| 137 | 139 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 138 | 140 |
continuous = FALSE, rootnode = TRUE, |
| 139 |
- nsplit = 100, extend=0.002) {
|
|
| 141 |
+ nsplit = 100, extend=0.002, inhibit.size = TRUE) {
|
|
| 140 | 142 |
.fun <- function(data) {
|
| 141 | 143 |
df <- setup_tree_data(data) |
| 142 | 144 |
x <- df$x |
| ... | ... |
@@ -157,26 +159,48 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 157 | 159 |
} |
| 158 | 160 |
|
| 159 | 161 |
if (continuous) {
|
| 162 |
+ # using ggnewscale new_scale("color") for multiple color scales
|
|
| 163 |
+ if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
|
| 164 |
+ names(df)[grep("colour_new", names(df))] <- "colour"
|
|
| 165 |
+ } |
|
| 160 | 166 |
if (!is.null(df$colour)){
|
| 167 |
+ if (any(is.na(df$colour))){
|
|
| 168 |
+ df$colour[is.na(df$colour)] <- 0 |
|
| 169 |
+ } |
|
| 161 | 170 |
df$col2 <- df$colour |
| 162 | 171 |
df$col <- df$col2[ii] |
| 163 | 172 |
} |
| 173 |
+ # using ggnewscale new_scale("size") for multiple size scales
|
|
| 174 |
+ if (length(grep("size_new", names(df)))==1 && !"size" %in% names(df)){
|
|
| 175 |
+ names(df)[grep("size_new", names(df))] <- "size"
|
|
| 176 |
+ } |
|
| 164 | 177 |
if (!is.null(df$size)){
|
| 178 |
+ if (any(is.na(df$size))){
|
|
| 179 |
+ df$size[is.na(df$size)] <- 0 |
|
| 180 |
+ } |
|
| 165 | 181 |
df$size2 <- df$size |
| 166 | 182 |
df$size1 <- df$size2[ii] |
| 167 | 183 |
} |
| 168 |
- setup_data_continuous_color_size_tree(df, nsplit = nsplit, extend = extend) |
|
| 184 |
+ setup_data_continuous_color_size_tree(df, nsplit = nsplit, extend = extend, inhibit.size = inhibit.size) |
|
| 169 | 185 |
} else {
|
| 170 | 186 |
return(df) |
| 171 | 187 |
} |
| 172 | 188 |
} |
| 173 |
- |
|
| 189 |
+ |
|
| 174 | 190 |
if ('.id' %in% names(data)) {
|
| 175 | 191 |
ldf <- split(data, data$.id) |
| 176 | 192 |
df <- do.call(rbind, lapply(ldf, .fun)) |
| 177 | 193 |
} else {
|
| 178 | 194 |
df <- .fun(data) |
| 179 | 195 |
} |
| 196 |
+ |
|
| 197 |
+ # using ggnewscale new_scale for multiple color or size scales |
|
| 198 |
+ if (length(grep("colour_new", names(data)))==1 && continuous){
|
|
| 199 |
+ names(df)[match("colour", names(df))] <- names(data)[grep("colour_new", names(data))]
|
|
| 200 |
+ } |
|
| 201 |
+ if (length(grep("size_new", names(data)))==1 && continuous){
|
|
| 202 |
+ names(df)[match("size", names(df))] <- names(data)[grep("size_new", names(data))]
|
|
| 203 |
+ } |
|
| 180 | 204 |
return(df) |
| 181 | 205 |
} |
| 182 | 206 |
) |
| ... | ... |
@@ -189,7 +213,7 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 189 | 213 |
}, |
| 190 | 214 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 191 | 215 |
continuous = FALSE, nsplit=100, |
| 192 |
- extend=0.002, rootnode = TRUE) {
|
|
| 216 |
+ extend=0.002, rootnode = TRUE, inhibit.size = TRUE) {
|
|
| 193 | 217 |
.fun <- function(data) {
|
| 194 | 218 |
df <- setup_tree_data(data) |
| 195 | 219 |
x <- df$x |
| ... | ... |
@@ -205,22 +229,44 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 205 | 229 |
} |
| 206 | 230 |
|
| 207 | 231 |
if (continuous){
|
| 232 |
+ # using ggnewscale new_scale("color") for multiple color scales
|
|
| 233 |
+ if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
|
| 234 |
+ names(df)[grep("colour_new", names(df))] <- "colour"
|
|
| 235 |
+ } |
|
| 208 | 236 |
if (!is.null(df$colour)){
|
| 237 |
+ if (any(is.na(df$colour))){
|
|
| 238 |
+ df$colour[is.na(df$colour)] <- 0 |
|
| 239 |
+ } |
|
| 209 | 240 |
df$colour <- df$colour[ii] |
| 210 | 241 |
} |
| 242 |
+ # using ggnewscale new_scale("size") for multiple size scales
|
|
| 243 |
+ if (length(grep("size_new", names(df)))==1 && !"size" %in% names(df)){
|
|
| 244 |
+ names(df)[grep("size_new", names(df))] <- "size"
|
|
| 245 |
+ } |
|
| 211 | 246 |
if (!is.null(df$size)){
|
| 247 |
+ if (any(is.na(df$size))){
|
|
| 248 |
+ df$size[is.na(df$size)] <- 0 |
|
| 249 |
+ } |
|
| 212 | 250 |
df$size <- df$size[ii] |
| 213 | 251 |
} |
| 214 | 252 |
} |
| 215 | 253 |
return(df) |
| 216 | 254 |
} |
| 217 |
- |
|
| 255 |
+ |
|
| 218 | 256 |
if ('.id' %in% names(data)) {
|
| 219 | 257 |
ldf <- split(data, data$.id) |
| 220 | 258 |
df <- do.call(rbind, lapply(ldf, .fun)) |
| 221 | 259 |
} else {
|
| 222 | 260 |
df <- .fun(data) |
| 223 | 261 |
} |
| 262 |
+ |
|
| 263 |
+ # using ggnewscale new_scale for multiple color or size scales |
|
| 264 |
+ if (length(grep("colour_new", names(data)))==1 && continuous){
|
|
| 265 |
+ names(df)[match("colour", names(df))] <- names(data)[grep("colour_new", names(data))]
|
|
| 266 |
+ } |
|
| 267 |
+ if (length(grep("size_new", names(data)))==1 && continuous){
|
|
| 268 |
+ names(df)[match("size", names(df))] <- names(data)[grep("size_new", names(data))]
|
|
| 269 |
+ } |
|
| 224 | 270 |
return(df) |
| 225 | 271 |
} |
| 226 | 272 |
) |
| ... | ... |
@@ -234,7 +280,7 @@ StatTree <- ggproto("StatTree", Stat,
|
| 234 | 280 |
}, |
| 235 | 281 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 236 | 282 |
continuous = FALSE, nsplit = 100, |
| 237 |
- extend = 0.002, rootnode = TRUE) {
|
|
| 283 |
+ extend = 0.002, rootnode = TRUE, inhibit.size = TRUE) {
|
|
| 238 | 284 |
.fun <- function(data) {
|
| 239 | 285 |
df <- setup_tree_data(data) |
| 240 | 286 |
x <- df$x |
| ... | ... |
@@ -250,15 +296,29 @@ StatTree <- ggproto("StatTree", Stat,
|
| 250 | 296 |
} |
| 251 | 297 |
|
| 252 | 298 |
if (continuous) {
|
| 299 |
+ # using ggnewscale new_scale("color") for multiple color scales
|
|
| 300 |
+ if (length(grep("colour_new", names(df)))==1 && !"colour" %in% names(df)){
|
|
| 301 |
+ names(df)[grep("colour_new", names(df))] <- "colour"
|
|
| 302 |
+ } |
|
| 253 | 303 |
if (!is.null(df$colour)){
|
| 304 |
+ if (any(is.na(df$colour))){
|
|
| 305 |
+ df$colour[is.na(df$colour)] <- 0 |
|
| 306 |
+ } |
|
| 254 | 307 |
df$col2 <- df$colour |
| 255 | 308 |
df$col <- df$col2[ii] |
| 256 | 309 |
} |
| 310 |
+ # using ggnewscale new_scale("size") for multiple size scales
|
|
| 311 |
+ if (length(grep("size_new", names(df)))==1 && !"size" %in% names(df)){
|
|
| 312 |
+ names(df)[grep("size_new", names(df))] <- "size"
|
|
| 313 |
+ } |
|
| 257 | 314 |
if (!is.null(df$size)){
|
| 315 |
+ if (any(is.na(df$size))){
|
|
| 316 |
+ df$size[is.na(df$size)] <- 0 |
|
| 317 |
+ } |
|
| 258 | 318 |
df$size2 <- df$size |
| 259 | 319 |
df$size1 <- df$size2[ii] |
| 260 | 320 |
} |
| 261 |
- setup_data_continuous_color_size_tree(df, nsplit = nsplit, extend = extend) |
|
| 321 |
+ setup_data_continuous_color_size_tree(df, nsplit = nsplit, extend = extend, inhibit.size = inhibit.size) |
|
| 262 | 322 |
} else{
|
| 263 | 323 |
return(df) |
| 264 | 324 |
} |
| ... | ... |
@@ -269,6 +329,15 @@ StatTree <- ggproto("StatTree", Stat,
|
| 269 | 329 |
} else {
|
| 270 | 330 |
df <- .fun(data) |
| 271 | 331 |
} |
| 332 |
+ |
|
| 333 |
+ # using ggnewscale new_scale for multiple color or size scales |
|
| 334 |
+ if (length(grep("colour_new", names(data)))==1 && continuous){
|
|
| 335 |
+ names(df)[match("colour", names(df))] <- names(data)[grep("colour_new", names(data))]
|
|
| 336 |
+ } |
|
| 337 |
+ if (length(grep("size_new", names(data)))==1 && continuous){
|
|
| 338 |
+ names(df)[match("size", names(df))] <- names(data)[grep("size_new", names(data))]
|
|
| 339 |
+ } |
|
| 340 |
+ |
|
| 272 | 341 |
return(df) |
| 273 | 342 |
} |
| 274 | 343 |
) |
| ... | ... |
@@ -283,7 +352,7 @@ StatTreeEllipse <- ggproto("StatTreeEllipse", Stat,
|
| 283 | 352 |
continuous = FALSE, nsplit = 100, |
| 284 | 353 |
extend = 0.002, rootnode = TRUE){
|
| 285 | 354 |
if (continuous){
|
| 286 |
- stop("continuous is not implemented for roundrect or ellipse layout")
|
|
| 355 |
+ stop("continuous colour or size are not implemented for roundrect or ellipse layout")
|
|
| 287 | 356 |
} |
| 288 | 357 |
df <- StatTree$compute_panel(data = data, scales = scales, |
| 289 | 358 |
params = params, layout = layout, lineend = lineend, |
| ... | ... |
@@ -406,7 +475,7 @@ setup_data_continuous_color_size <- function(x, xend, y, yend, col, col2, size1, |
| 406 | 475 |
return(dat) |
| 407 | 476 |
} |
| 408 | 477 |
|
| 409 |
-setup_data_continuous_color_size_tree <- function(df, nsplit = 100, extend = 0.002) {
|
|
| 478 |
+setup_data_continuous_color_size_tree <- function(df, nsplit = 100, extend = 0.002, inhibit.size=TRUE) {
|
|
| 410 | 479 |
lapply(1:nrow(df), function(i) {
|
| 411 | 480 |
df2 <- setup_data_continuous_color_size(x = df$x[i], |
| 412 | 481 |
xend = df$xend[i], |
| ... | ... |
@@ -420,8 +489,12 @@ setup_data_continuous_color_size_tree <- function(df, nsplit = 100, extend = 0.0 |
| 420 | 489 |
nsplit = nsplit, |
| 421 | 490 |
extend = extend) |
| 422 | 491 |
df2$node <- df$node[i] |
| 423 |
- |
|
| 424 |
- j <- match(c('x', 'xend', 'y', 'yend', 'col', 'col2', 'colour', 'size1', 'size2', 'size'), colnames(df))
|
|
| 492 |
+ if (inhibit.size){
|
|
| 493 |
+ j <- match(c('x', 'xend', 'y', 'yend', 'col', 'col2', 'colour', 'size1', 'size2'), colnames(df))
|
|
| 494 |
+ df2$size <- NULL |
|
| 495 |
+ }else{
|
|
| 496 |
+ j <- match(c('x', 'xend', 'y', 'yend', 'col', 'col2', 'colour', 'size1', 'size2', 'size'), colnames(df))
|
|
| 497 |
+ } |
|
| 425 | 498 |
j <- j[!is.na(j)] |
| 426 | 499 |
merge(df[i, -j, drop = FALSE], df2, by = "node") |
| 427 | 500 |
}) %>% do.call('rbind', .)
|
xiangpin authored on 05/11/2020 03:44:57
| ... | ... |
@@ -6,9 +6,22 @@ |
| 6 | 6 |
##' @param data data |
| 7 | 7 |
##' @param layout one of 'rectangular', 'dendrogram', 'slanted', 'ellipse', 'roundrect', |
| 8 | 8 |
##' 'fan', 'circular', 'inward_circular', 'radial', 'equal_angle', 'daylight' or 'ape' |
| 9 |
-##' @param multiPhylo logical |
|
| 9 |
+##' @param multiPhylo logical, whether input data contains multiple phylo class. |
|
| 10 | 10 |
##' @param ... additional parameter |
| 11 |
+##' |
|
| 12 |
+##' some dot arguments: |
|
| 13 |
+##' \itemize{
|
|
| 14 |
+##' \item \code{continuous} logical, whether the aesthethic of `size` or `color` is continuous, default is FALSE.
|
|
| 15 |
+##' \item \code{nsplit} integer, the number of branch blocks divided when `continuous` is TRUE, default is 200.
|
|
| 16 |
+##' } |
|
| 11 | 17 |
##' @return tree layer |
| 18 |
+##' @section Aesthetics: |
|
| 19 |
+#' \code{geom_tree()} understands the following aesthethics:
|
|
| 20 |
+##' \itemize{
|
|
| 21 |
+##' \item \code{colour} logical, control the color of line, default is black.
|
|
| 22 |
+##' \item \code{linetype} control the type of line, default is 1 (solid).
|
|
| 23 |
+##' \item \code{size} numeric, control the width of line, default is 0.5.
|
|
| 24 |
+##' } |
|
| 12 | 25 |
##' @importFrom ggplot2 geom_segment |
| 13 | 26 |
##' @importFrom ggplot2 aes |
| 14 | 27 |
##' @export |
xiangpin authored on 28/10/2020 13:54:03
| ... | ... |
@@ -122,7 +122,8 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 122 | 122 |
data |
| 123 | 123 |
}, |
| 124 | 124 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 125 |
- continuous = FALSE, rootnode = TRUE) {
|
|
| 125 |
+ continuous = FALSE, rootnode = TRUE, |
|
| 126 |
+ nsplit = 100, extend=0.002) {
|
|
| 126 | 127 |
.fun <- function(data) {
|
| 127 | 128 |
df <- setup_tree_data(data) |
| 128 | 129 |
x <- df$x |
| ... | ... |
@@ -151,7 +152,7 @@ StatTreeHorizontal <- ggproto("StatTreeHorizontal", Stat,
|
| 151 | 152 |
df$size2 <- df$size |
| 152 | 153 |
df$size1 <- df$size2[ii] |
| 153 | 154 |
} |
| 154 |
- setup_data_continuous_color_size_tree(df, nsplit = 100, extend = 0.002) |
|
| 155 |
+ setup_data_continuous_color_size_tree(df, nsplit = nsplit, extend = extend) |
|
| 155 | 156 |
} else {
|
| 156 | 157 |
return(df) |
| 157 | 158 |
} |
| ... | ... |
@@ -174,7 +175,8 @@ StatTreeVertical <- ggproto("StatTreeVertical", Stat,
|
| 174 | 175 |
data |
| 175 | 176 |
}, |
| 176 | 177 |
compute_panel = function(self, data, scales, params, layout, lineend, |
| 177 |
- continuous = FALSE, rootnode = TRUE) {
|
