git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@106964 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -1,7 +1,7 @@ |
1 | 1 |
Package: ggtree |
2 | 2 |
Type: Package |
3 | 3 |
Title: a phylogenetic tree viewer for different types of tree annotations |
4 |
-Version: 1.1.12 |
|
4 |
+Version: 1.1.13 |
|
5 | 5 |
Author: Guangchuang Yu and Tommy Tsan-Yuk Lam |
6 | 6 |
Maintainer: Guangchuang Yu <guangchuangyu@gmail.com> |
7 | 7 |
Description: ggtree extends the ggplot2 plotting system which implemented the |
... | ... |
@@ -1,3 +1,8 @@ |
1 |
+CHANGES IN VERSION 1.1.13 |
|
2 |
+------------------------ |
|
3 |
+ o better implementation of geom_tiplab for accepting aes mapping and auto add align dotted line <2015-08-01, Sat> |
|
4 |
+ o open group_name parameter of groupOTU/groupClade to user <2015-08-01, Sat> |
|
5 |
+ |
|
1 | 6 |
CHANGES IN VERSION 1.1.12 |
2 | 7 |
------------------------ |
3 | 8 |
o update vignette according to the changes <2015-07-31, Fri> |
... | ... |
@@ -110,9 +110,10 @@ setGeneric("get.tipseq", function(object, ...) standardGeneric("get.tipseq")) |
110 | 110 |
##' @param object supported objects, including phylo, paml_rst, |
111 | 111 |
##' codeml_mlc, codeml, jplace, beast, hyphy |
112 | 112 |
##' @param focus a vector of tip (label or number) or a list of tips. |
113 |
+##' @param group_name name of the group, 'group' by default |
|
113 | 114 |
##' @return group index |
114 | 115 |
##' @export |
115 |
-setGeneric("groupOTU", function(object, focus) standardGeneric("groupOTU")) |
|
116 |
+setGeneric("groupOTU", function(object, focus, group_name="group") standardGeneric("groupOTU")) |
|
116 | 117 |
|
117 | 118 |
##' @docType methods |
118 | 119 |
##' @name groupClade |
... | ... |
@@ -121,9 +122,10 @@ setGeneric("groupOTU", function(object, focus) standardGeneric("groupOTU")) |
121 | 122 |
##' @param object supported objects, including phylo, paml_rst, |
122 | 123 |
##' codeml_mlc, codeml, jplace, beast, hyphy |
123 | 124 |
##' @param node a internal node or a vector of internal nodes |
125 |
+##' @param group_name name of the group, 'group' by default |
|
124 | 126 |
##' @return group index |
125 | 127 |
##' @export |
126 |
-setGeneric("groupClade", function(object, node) standardGeneric("groupClade")) |
|
128 |
+setGeneric("groupClade", function(object, node, group_name="group") standardGeneric("groupClade")) |
|
127 | 129 |
|
128 | 130 |
|
129 | 131 |
##' @docType methods |
... | ... |
@@ -102,16 +102,16 @@ setMethod("show", signature(object = "beast"), |
102 | 102 |
##' @rdname groupOTU-methods |
103 | 103 |
##' @exportMethod groupOTU |
104 | 104 |
setMethod("groupOTU", signature(object="beast"), |
105 |
- function(object, focus) { |
|
106 |
- groupOTU_(object, focus) |
|
105 |
+ function(object, focus, group_name="group") { |
|
106 |
+ groupOTU_(object, focus, group_name) |
|
107 | 107 |
} |
108 | 108 |
) |
109 | 109 |
|
110 | 110 |
##' @rdname groupClade-methods |
111 | 111 |
##' @exportMethod groupClade |
112 | 112 |
setMethod("groupClade", signature(object="beast"), |
113 |
- function(object, node) { |
|
114 |
- groupClade_(object, node) |
|
113 |
+ function(object, node, group_name="group") { |
|
114 |
+ groupClade_(object, node, group_name) |
|
115 | 115 |
}) |
116 | 116 |
|
117 | 117 |
##' @rdname scale_color-methods |
... | ... |
@@ -25,16 +25,16 @@ read.codeml <- function(rstfile, mlcfile) { |
25 | 25 |
##' @rdname groupOTU-methods |
26 | 26 |
##' @exportMethod groupOTU |
27 | 27 |
setMethod("groupOTU", signature(object="codeml"), |
28 |
- function(object, focus) { |
|
29 |
- groupOTU_(object, focus) |
|
28 |
+ function(object, focus, group_name="group") { |
|
29 |
+ groupOTU_(object, focus, group_name) |
|
30 | 30 |
} |
31 | 31 |
) |
32 | 32 |
|
33 | 33 |
##' @rdname groupClade-methods |
34 | 34 |
##' @exportMethod groupClade |
35 | 35 |
setMethod("groupClade", signature(object="codeml"), |
36 |
- function(object, node) { |
|
37 |
- groupClade_(object, node) |
|
36 |
+ function(object, node, group_name="group") { |
|
37 |
+ groupClade_(object, node, group_name) |
|
38 | 38 |
} |
39 | 39 |
) |
40 | 40 |
|
... | ... |
@@ -34,16 +34,16 @@ setMethod("gzoom", signature(object="codeml_mlc"), |
34 | 34 |
##' @rdname groupOTU-methods |
35 | 35 |
##' @exportMethod groupOTU |
36 | 36 |
setMethod("groupOTU", signature(object="codeml_mlc"), |
37 |
- function(object, focus) { |
|
38 |
- groupOTU_(object, focus) |
|
37 |
+ function(object, focus, group_name="group") { |
|
38 |
+ groupOTU_(object, focus, group_name) |
|
39 | 39 |
} |
40 | 40 |
) |
41 | 41 |
|
42 | 42 |
##' @rdname groupClade-methods |
43 | 43 |
##' @exportMethod groupClade |
44 | 44 |
setMethod("groupClade", signature(object="codeml_mlc"), |
45 |
- function(object, node) { |
|
46 |
- groupClade_(object, node) |
|
45 |
+ function(object, node, group_name="group") { |
|
46 |
+ groupClade_(object, node, group_name) |
|
47 | 47 |
} |
48 | 48 |
) |
49 | 49 |
|
... | ... |
@@ -156,8 +156,11 @@ geom_hilight <- function(tree_object, node, ...) { |
156 | 156 |
##' |
157 | 157 |
##' |
158 | 158 |
##' @title geom_tiplab |
159 |
-##' @param align align tip lab or not, logical |
|
159 |
+##' @param mapping aes mapping |
|
160 | 160 |
##' @param hjust horizontal adjustment |
161 |
+##' @param align align tip lab or not, logical |
|
162 |
+##' @param linetype linetype for adding line if align = TRUE |
|
163 |
+##' @param line.size line size of line if align = TRUE |
|
161 | 164 |
##' @param ... additional parameter |
162 | 165 |
##' @return tip label layer |
163 | 166 |
##' @importFrom ggplot2 geom_text |
... | ... |
@@ -167,13 +170,39 @@ geom_hilight <- function(tree_object, node, ...) { |
167 | 170 |
##' require(ape) |
168 | 171 |
##' tr <- rtree(10) |
169 | 172 |
##' ggtree(tr) + geom_tiplab() |
170 |
-geom_tiplab <- function(align=FALSE, hjust=0, ...) { |
|
173 |
+geom_tiplab <- function(mapping=NULL, hjust = 0, align = FALSE, linetype = "dotted", line.size=1, ...) { |
|
171 | 174 |
x <- y <- label <- isTip <- NULL |
172 | 175 |
if (align == TRUE) { |
173 |
- geom_text(aes(x=max(x)+ diff(range(x))/200, label=label), subset=.(isTip), hjust=hjust, ...) |
|
176 |
+ self_mapping <- aes(x = max(x) + diff(range(x))/200, label = label) |
|
177 |
+ } |
|
178 |
+ else { |
|
179 |
+ self_mapping <- aes(x = x + diff(range(x))/200, label = label) |
|
180 |
+ } |
|
181 |
+ |
|
182 |
+ if (is.null(mapping)) { |
|
183 |
+ text_mapping <- self_mapping |
|
174 | 184 |
} else { |
175 |
- geom_text(aes(x = x + diff(range(x))/200, label=label), subset=.(isTip), hjust=hjust, ...) |
|
185 |
+ text_mapping <- modifyList(self_mapping, mapping) |
|
176 | 186 |
} |
187 |
+ |
|
188 |
+ dot_mapping <- NULL |
|
189 |
+ if (align && (!is.na(linetype) || !is.null(linetype))) { |
|
190 |
+ dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y) |
|
191 |
+ if (!is.null(mapping)) { |
|
192 |
+ dot_mapping <- modifyList(dot_mapping, mapping) |
|
193 |
+ } |
|
194 |
+ } |
|
195 |
+ |
|
196 |
+ list( |
|
197 |
+ geom_text(mapping=text_mapping, |
|
198 |
+ subset = .(isTip), |
|
199 |
+ hjust = hjust, ...), |
|
200 |
+ if (!is.null(dot_mapping)) |
|
201 |
+ geom_segment(mapping=dot_mapping, |
|
202 |
+ subset=.(isTip), |
|
203 |
+ linetype = linetype, |
|
204 |
+ size = line.size, ...) |
|
205 |
+ ) |
|
177 | 206 |
} |
178 | 207 |
|
179 | 208 |
|
... | ... |
@@ -621,6 +650,7 @@ add_colorbar <- function(p, color, x=NULL, ymin=NULL, ymax=NULL, font.size=4) { |
621 | 650 |
##' @return tree view |
622 | 651 |
##' @importFrom grid linesGrob |
623 | 652 |
##' @importFrom grid textGrob |
653 |
+##' @importFrom ggplot2 ylim |
|
624 | 654 |
##' @export |
625 | 655 |
##' @author Guangchuang Yu |
626 | 656 |
add_legend <- function(p, x=NULL, y=NULL, offset=NULL, font.size=4, ...) { |
... | ... |
@@ -688,7 +718,7 @@ annotation_clade <- function(tree_view, node, label, bar.size=2, font.size=4, of |
688 | 718 |
sp.df <- df[c(sp, node), ] |
689 | 719 |
y <- sp.df$y |
690 | 720 |
|
691 |
- mx <- max(p$data$x) + offset |
|
721 |
+ mx <- max(df$x) + offset |
|
692 | 722 |
annotation_clade_internal(tree_view, mx, y, label, bar.size, font.size, offset.text, ...) |
693 | 723 |
} |
694 | 724 |
|
... | ... |
@@ -715,7 +745,7 @@ annotation_clade2 <- function(tree_view, tip1, tip2, label, bar.size=2, font.siz |
715 | 745 |
y <- c(df[which(tip1 == df$label | tip1 == df$node), "y"], |
716 | 746 |
df[which(tip2 == df$label | tip2 == df$node), "y"]) |
717 | 747 |
|
718 |
- mx <- max(p$data$x) + offset |
|
748 |
+ mx <- max(df$x) + offset |
|
719 | 749 |
annotation_clade_internal(tree_view, mx, y, label, bar.size, font.size, offset.text, ...) |
720 | 750 |
} |
721 | 751 |
|
... | ... |
@@ -732,50 +762,31 @@ annotation_clade_internal <- function(tree_view, x, y, label, bar.size, font.siz |
732 | 762 |
##' @rdname groupOTU-methods |
733 | 763 |
##' @exportMethod groupOTU |
734 | 764 |
setMethod("groupOTU", signature(object="ggplot"), |
735 |
- function(object, focus) { |
|
736 |
- groupOTU.ggplot(object, focus) |
|
765 |
+ function(object, focus, group_name="group") { |
|
766 |
+ groupOTU.ggplot(object, focus, group_name) |
|
737 | 767 |
}) |
738 | 768 |
|
739 | 769 |
|
740 | 770 |
##' @rdname groupOTU-methods |
741 | 771 |
##' @exportMethod groupOTU |
742 | 772 |
setMethod("groupOTU", signature(object="gg"), |
743 |
- function(object, focus) { |
|
744 |
- groupOTU.ggplot(object, focus) |
|
773 |
+ function(object, focus, group_name) { |
|
774 |
+ groupOTU.ggplot(object, focus, group_name) |
|
745 | 775 |
}) |
746 | 776 |
|
747 | 777 |
|
748 | 778 |
##' @rdname groupClade-methods |
749 | 779 |
##' @exportMethod groupClade |
750 | 780 |
setMethod("groupClade", signature(object="ggplot"), |
751 |
- function(object, node) { |
|
752 |
- groupClade.ggplot(object, node) |
|
781 |
+ function(object, node, group_name) { |
|
782 |
+ groupClade.ggplot(object, node, group_name) |
|
753 | 783 |
}) |
754 | 784 |
|
755 | 785 |
|
756 | 786 |
##' @rdname groupClade-methods |
757 | 787 |
##' @exportMethod groupClade |
758 | 788 |
setMethod("groupClade", signature(object="gg"), |
759 |
- function(object, node) { |
|
760 |
- groupClade.ggplot(object, node) |
|
789 |
+ function(object, node, group_name) { |
|
790 |
+ groupClade.ggplot(object, node, group_name) |
|
761 | 791 |
}) |
762 | 792 |
|
763 |
- |
|
764 |
-groupClade.ggplot <- function(object, nodes) { |
|
765 |
- df <- object$data |
|
766 |
- group_name <- "group" |
|
767 |
- df[, group_name] <- 0 |
|
768 |
- for (node in nodes) { |
|
769 |
- df <- groupClade.df(df, node, group_name) |
|
770 |
- } |
|
771 |
- df$group <- factor(df$group) |
|
772 |
- object$data <- df |
|
773 |
- return(object) |
|
774 |
-} |
|
775 |
- |
|
776 |
-groupClade.df <- function(df, node, group_name) { |
|
777 |
- foc <- c(node, get.offspring.df(df, node)) |
|
778 |
- idx <- match(foc, df$node) |
|
779 |
- df[idx, group_name] <- max(df$group) + 1 |
|
780 |
- return(df) |
|
781 |
-} |
... | ... |
@@ -92,16 +92,16 @@ setMethod("plot", signature(x = "hyphy"), |
92 | 92 |
##' @rdname groupOTU-methods |
93 | 93 |
##' @exportMethod groupOTU |
94 | 94 |
setMethod("groupOTU", signature(object="hyphy"), |
95 |
- function(object, focus) { |
|
96 |
- groupOTU_(object, focus) |
|
95 |
+ function(object, focus, group_name="group") { |
|
96 |
+ groupOTU_(object, focus, group_name) |
|
97 | 97 |
} |
98 | 98 |
) |
99 | 99 |
|
100 | 100 |
##' @rdname groupClade-methods |
101 | 101 |
##' @exportMethod groupClade |
102 | 102 |
setMethod("groupClade", signature(object="hyphy"), |
103 |
- function(object, node) { |
|
104 |
- groupClade_(object, node) |
|
103 |
+ function(object, node, group_name="group") { |
|
104 |
+ groupClade_(object, node, group_name) |
|
105 | 105 |
} |
106 | 106 |
) |
107 | 107 |
|
... | ... |
@@ -29,16 +29,16 @@ read.jplace <- function(file) { |
29 | 29 |
##' @rdname groupOTU-methods |
30 | 30 |
##' @exportMethod groupOTU |
31 | 31 |
setMethod("groupOTU", signature(object="jplace"), |
32 |
- function(object, focus) { |
|
33 |
- groupOTU_(object, focus) |
|
32 |
+ function(object, focus, group_name="group") { |
|
33 |
+ groupOTU_(object, focus, group_name) |
|
34 | 34 |
} |
35 | 35 |
) |
36 | 36 |
|
37 | 37 |
##' @rdname groupClade-methods |
38 | 38 |
##' @exportMethod groupClade |
39 | 39 |
setMethod("groupClade", signature(object="jplace"), |
40 |
- function(object, node) { |
|
41 |
- groupClade_(object, node) |
|
40 |
+ function(object, node, group_name="group") { |
|
41 |
+ groupClade_(object, node, group_name) |
|
42 | 42 |
} |
43 | 43 |
) |
44 | 44 |
|
... | ... |
@@ -72,16 +72,16 @@ setMethod("gzoom", signature(object="paml_rst"), |
72 | 72 |
##' @rdname groupOTU-methods |
73 | 73 |
##' @exportMethod groupOTU |
74 | 74 |
setMethod("groupOTU", signature(object="paml_rst"), |
75 |
- function(object, focus) { |
|
76 |
- groupOTU_(object, focus) |
|
75 |
+ function(object, focus, group_name="group") { |
|
76 |
+ groupOTU_(object, focus, group_name) |
|
77 | 77 |
} |
78 | 78 |
) |
79 | 79 |
|
80 | 80 |
##' @rdname groupClade-methods |
81 | 81 |
##' @exportMethod groupClade |
82 | 82 |
setMethod("groupClade", signature(object="paml_rst"), |
83 |
- function(object, node) { |
|
84 |
- groupClade_(object, node) |
|
83 |
+ function(object, node, group_name="group") { |
|
84 |
+ groupClade_(object, node, group_name) |
|
85 | 85 |
} |
86 | 86 |
) |
87 | 87 |
|
... | ... |
@@ -16,8 +16,8 @@ setMethod("scale_color", signature(object="phylo"), |
16 | 16 |
##' @rdname groupOTU-methods |
17 | 17 |
##' @exportMethod groupOTU |
18 | 18 |
setMethod("groupOTU", signature(object="phylo"), |
19 |
- function(object, focus) { |
|
20 |
- groupOTU.phylo(object, focus) |
|
19 |
+ function(object, focus, group_name="group") { |
|
20 |
+ groupOTU.phylo(object, focus, group_name) |
|
21 | 21 |
}) |
22 | 22 |
|
23 | 23 |
|
... | ... |
@@ -27,6 +27,7 @@ setMethod("groupOTU", signature(object="phylo"), |
27 | 27 |
##' @title groupOTU.phylo |
28 | 28 |
##' @param phy tree object |
29 | 29 |
##' @param focus tip list |
30 |
+##' @param group_name name of the group |
|
30 | 31 |
##' @return phylo object |
31 | 32 |
##' @author ygc |
32 | 33 |
groupOTU.phylo <- function(phy, focus, group_name="group") { |
... | ... |
@@ -45,11 +46,11 @@ groupOTU.phylo <- function(phy, focus, group_name="group") { |
45 | 46 |
##' @rdname groupClade-methods |
46 | 47 |
##' @exportMethod groupClade |
47 | 48 |
setMethod("groupClade", signature(object="phylo"), |
48 |
- function(object, node) { |
|
49 |
- groupClade.phylo(object, node) |
|
49 |
+ function(object, node, group_name="group") { |
|
50 |
+ groupClade.phylo(object, node, group_name) |
|
50 | 51 |
}) |
51 | 52 |
|
52 |
-groupClade.phylo <- function(object, node) { |
|
53 |
+groupClade.phylo <- function(object, node, group_name) { |
|
53 | 54 |
if (length(node) == 1) { |
54 | 55 |
clade <- extract.clade(object, node) |
55 | 56 |
tips <- clade$tip.label |
... | ... |
@@ -60,7 +61,7 @@ groupClade.phylo <- function(object, node) { |
60 | 61 |
}) |
61 | 62 |
} |
62 | 63 |
|
63 |
- groupOTU.phylo(object, tips, "group") |
|
64 |
+ groupOTU.phylo(object, tips, group_name) |
|
64 | 65 |
} |
65 | 66 |
|
66 | 67 |
|
... | ... |
@@ -55,20 +55,20 @@ scale_color_ <- function(phylo, by, low=NULL, high=NULL, na.color=NULL, default. |
55 | 55 |
return(color) |
56 | 56 |
} |
57 | 57 |
|
58 |
-groupClade_ <- function(object, node) { |
|
58 |
+groupClade_ <- function(object, node, group_name) { |
|
59 | 59 |
if (is(object, "phylo")) { |
60 |
- object <- groupClade.phylo(object, node) |
|
60 |
+ object <- groupClade.phylo(object, node, group_name) |
|
61 | 61 |
} else { |
62 |
- object@phylo <- groupClade.phylo(get.tree(object), node) |
|
62 |
+ object@phylo <- groupClade.phylo(get.tree(object), node, group_name) |
|
63 | 63 |
} |
64 | 64 |
return(object) |
65 | 65 |
} |
66 | 66 |
|
67 |
-groupOTU_ <- function(object, focus) { |
|
67 |
+groupOTU_ <- function(object, focus, group_name) { |
|
68 | 68 |
if (is(object, "phylo")) { |
69 |
- object <- groupOTU.phylo(object, focus) |
|
69 |
+ object <- groupOTU.phylo(object, focus, group_name) |
|
70 | 70 |
} else { |
71 |
- object@phylo <- groupOTU.phylo(get.tree(object), focus) |
|
71 |
+ object@phylo <- groupOTU.phylo(get.tree(object), focus, group_name) |
|
72 | 72 |
} |
73 | 73 |
return(object) |
74 | 74 |
} |
... | ... |
@@ -454,8 +454,14 @@ fortify.phylo <- function(model, data, layout="phylogram", |
454 | 454 |
if(layout == "cladogram") { |
455 | 455 |
df <- add_angle_cladogram(df) |
456 | 456 |
} |
457 |
- if (!is.null(attr(tree, "group"))) { |
|
458 |
- df$group <- attr(tree, "group") |
|
457 |
+ aa <- names(attributes(tree)) |
|
458 |
+ group <- aa[ ! aa %in% c("names", "class", "order")] |
|
459 |
+ if (length(group) > 0) { |
|
460 |
+ ## groupOTU & groupClade |
|
461 |
+ group_info <- attr(tree, group) |
|
462 |
+ if (length(group_info) == nrow(df)) { |
|
463 |
+ df[, group] <- group_info |
|
464 |
+ } |
|
459 | 465 |
} |
460 | 466 |
return(df) |
461 | 467 |
} |
... | ... |
@@ -527,7 +533,7 @@ as.data.frame.phylo_ <- function(x, layout="phylogram", |
527 | 533 |
|
528 | 534 |
if (layout == "fan") { |
529 | 535 |
idx <- match(1:N, order(res$y)) |
530 |
- angle <- -360/(N+1) * (1:N + 1) |
|
536 |
+ angle <- -360/(N+1) * 1:N |
|
531 | 537 |
angle <- angle[idx] |
532 | 538 |
res$angle <- angle |
533 | 539 |
} |
... | ... |
@@ -471,9 +471,28 @@ getCols <- function (n) { |
471 | 471 |
} |
472 | 472 |
|
473 | 473 |
|
474 |
-groupOTU.ggplot <- function(object, focus) { |
|
474 |
+ |
|
475 |
+groupClade.ggplot <- function(object, nodes, group_name) { |
|
476 |
+ df <- object$data |
|
477 |
+ df[, group_name] <- 0 |
|
478 |
+ for (node in nodes) { |
|
479 |
+ df <- groupClade.df(df, node, group_name) |
|
480 |
+ } |
|
481 |
+ df[, group_name] <- factor(df[, group_name]) |
|
482 |
+ object$data <- df |
|
483 |
+ return(object) |
|
484 |
+} |
|
485 |
+ |
|
486 |
+groupClade.df <- function(df, node, group_name) { |
|
487 |
+ foc <- c(node, get.offspring.df(df, node)) |
|
488 |
+ idx <- match(foc, df$node) |
|
489 |
+ df[idx, group_name] <- max(df[, group_name]) + 1 |
|
490 |
+ return(df) |
|
491 |
+} |
|
492 |
+ |
|
493 |
+ |
|
494 |
+groupOTU.ggplot <- function(object, focus, group_name) { |
|
475 | 495 |
df <- object$data |
476 |
- group_name <- "group" |
|
477 | 496 |
df[, group_name] <- 0 |
478 | 497 |
object$data <- groupOTU.df(df, focus, group_name) |
479 | 498 |
return(object) |
... | ... |
@@ -488,14 +507,14 @@ groupOTU.df <- function(df, focus, group_name) { |
488 | 507 |
} else { |
489 | 508 |
df <- gfocus.df(df, focus, group_name) |
490 | 509 |
} |
491 |
- df$group <- factor(df$group) |
|
510 |
+ df[, group_name] <- factor(df[, group_name]) |
|
492 | 511 |
return(df) |
493 | 512 |
} |
494 | 513 |
|
495 | 514 |
gfocus.df <- function(df, focus, group_name) { |
496 | 515 |
focus <- df$node[which(df$label %in% focus)] |
497 | 516 |
if (length(focus) == 1) { |
498 |
- df[match(focus, df$node), group_name] <- max(df(df$group)) + 1 |
|
517 |
+ df[match(focus, df$node), group_name] <- max(df(df[, group_name])) + 1 |
|
499 | 518 |
return(df) |
500 | 519 |
} |
501 | 520 |
|
... | ... |
@@ -509,7 +528,7 @@ gfocus.df <- function(df, focus, group_name) { |
509 | 528 |
foc <- c(foc, comAnc[1]) |
510 | 529 |
} |
511 | 530 |
idx <- match(foc, df$node) |
512 |
- df[idx, group_name] <- max(df$group) + 1 |
|
531 |
+ df[idx, group_name] <- max(df[, group_name]) + 1 |
|
513 | 532 |
return(df) |
514 | 533 |
} |
515 | 534 |
|
... | ... |
@@ -4,13 +4,20 @@ |
4 | 4 |
\alias{geom_tiplab} |
5 | 5 |
\title{geom_tiplab} |
6 | 6 |
\usage{ |
7 |
-geom_tiplab(align = FALSE, hjust = 0, ...) |
|
7 |
+geom_tiplab(mapping = NULL, hjust = 0, align = FALSE, |
|
8 |
+ linetype = "dotted", line.size = 1, ...) |
|
8 | 9 |
} |
9 | 10 |
\arguments{ |
10 |
-\item{align}{align tip lab or not, logical} |
|
11 |
+\item{mapping}{aes mapping} |
|
11 | 12 |
|
12 | 13 |
\item{hjust}{horizontal adjustment} |
13 | 14 |
|
15 |
+\item{align}{align tip lab or not, logical} |
|
16 |
+ |
|
17 |
+\item{linetype}{linetype for adding line if align = TRUE} |
|
18 |
+ |
|
19 |
+\item{line.size}{line size of line if align = TRUE} |
|
20 |
+ |
|
14 | 21 |
\item{...}{additional parameter} |
15 | 22 |
} |
16 | 23 |
\value{ |
... | ... |
@@ -14,31 +14,33 @@ |
14 | 14 |
\alias{groupClade,phylo-method} |
15 | 15 |
\title{groupClade method} |
16 | 16 |
\usage{ |
17 |
-groupClade(object, node) |
|
17 |
+groupClade(object, node, group_name = "group") |
|
18 | 18 |
|
19 |
-\S4method{groupClade}{beast}(object, node) |
|
19 |
+\S4method{groupClade}{beast}(object, node, group_name = "group") |
|
20 | 20 |
|
21 |
-\S4method{groupClade}{codeml}(object, node) |
|
21 |
+\S4method{groupClade}{codeml}(object, node, group_name = "group") |
|
22 | 22 |
|
23 |
-\S4method{groupClade}{codeml_mlc}(object, node) |
|
23 |
+\S4method{groupClade}{codeml_mlc}(object, node, group_name = "group") |
|
24 | 24 |
|
25 |
-\S4method{groupClade}{ggplot}(object, node) |
|
25 |
+\S4method{groupClade}{ggplot}(object, node, group_name = "group") |
|
26 | 26 |
|
27 |
-\S4method{groupClade}{gg}(object, node) |
|
27 |
+\S4method{groupClade}{gg}(object, node, group_name = "group") |
|
28 | 28 |
|
29 |
-\S4method{groupClade}{hyphy}(object, node) |
|
29 |
+\S4method{groupClade}{hyphy}(object, node, group_name = "group") |
|
30 | 30 |
|
31 |
-\S4method{groupClade}{jplace}(object, node) |
|
31 |
+\S4method{groupClade}{jplace}(object, node, group_name = "group") |
|
32 | 32 |
|
33 |
-\S4method{groupClade}{paml_rst}(object, node) |
|
33 |
+\S4method{groupClade}{paml_rst}(object, node, group_name = "group") |
|
34 | 34 |
|
35 |
-\S4method{groupClade}{phylo}(object, node) |
|
35 |
+\S4method{groupClade}{phylo}(object, node, group_name = "group") |
|
36 | 36 |
} |
37 | 37 |
\arguments{ |
38 | 38 |
\item{object}{supported objects, including phylo, paml_rst, |
39 | 39 |
codeml_mlc, codeml, jplace, beast, hyphy} |
40 | 40 |
|
41 | 41 |
\item{node}{a internal node or a vector of internal nodes} |
42 |
+ |
|
43 |
+\item{group_name}{name of the group, 'group' by default} |
|
42 | 44 |
} |
43 | 45 |
\value{ |
44 | 46 |
group index |
... | ... |
@@ -14,31 +14,33 @@ |
14 | 14 |
\alias{groupOTU,phylo-method} |
15 | 15 |
\title{groupOTU method} |
16 | 16 |
\usage{ |
17 |
-groupOTU(object, focus) |
|
17 |
+groupOTU(object, focus, group_name = "group") |
|
18 | 18 |
|
19 |
-\S4method{groupOTU}{beast}(object, focus) |
|
19 |
+\S4method{groupOTU}{beast}(object, focus, group_name = "group") |
|
20 | 20 |
|
21 |
-\S4method{groupOTU}{codeml}(object, focus) |
|
21 |
+\S4method{groupOTU}{codeml}(object, focus, group_name = "group") |
|
22 | 22 |
|
23 |
-\S4method{groupOTU}{codeml_mlc}(object, focus) |
|
23 |
+\S4method{groupOTU}{codeml_mlc}(object, focus, group_name = "group") |
|
24 | 24 |
|
25 |
-\S4method{groupOTU}{ggplot}(object, focus) |
|
25 |
+\S4method{groupOTU}{ggplot}(object, focus, group_name = "group") |
|
26 | 26 |
|
27 |
-\S4method{groupOTU}{gg}(object, focus) |
|
27 |
+\S4method{groupOTU}{gg}(object, focus, group_name = "group") |
|
28 | 28 |
|
29 |
-\S4method{groupOTU}{hyphy}(object, focus) |
|
29 |
+\S4method{groupOTU}{hyphy}(object, focus, group_name = "group") |
|
30 | 30 |
|
31 |
-\S4method{groupOTU}{jplace}(object, focus) |
|
31 |
+\S4method{groupOTU}{jplace}(object, focus, group_name = "group") |
|
32 | 32 |
|
33 |
-\S4method{groupOTU}{paml_rst}(object, focus) |
|
33 |
+\S4method{groupOTU}{paml_rst}(object, focus, group_name = "group") |
|
34 | 34 |
|
35 |
-\S4method{groupOTU}{phylo}(object, focus) |
|
35 |
+\S4method{groupOTU}{phylo}(object, focus, group_name = "group") |
|
36 | 36 |
} |
37 | 37 |
\arguments{ |
38 | 38 |
\item{object}{supported objects, including phylo, paml_rst, |
39 | 39 |
codeml_mlc, codeml, jplace, beast, hyphy} |
40 | 40 |
|
41 | 41 |
\item{focus}{a vector of tip (label or number) or a list of tips.} |
42 |
+ |
|
43 |
+\item{group_name}{name of the group, 'group' by default} |
|
42 | 44 |
} |
43 | 45 |
\value{ |
44 | 46 |
group index |
... | ... |
@@ -224,6 +224,17 @@ library("ggtree") |
224 | 224 |
gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label)) |
225 | 225 |
``` |
226 | 226 |
|
227 |
+## color tree |
|
228 |
+ |
|
229 |
+In `r Githubpkg("GuangchuangYu/ggtree")`, coloring phylogenetic tree is easy, by using `aes(color=VAR)` to map the color of tree based on a specific variable (numeric and category are both supported). |
|
230 |
+ |
|
231 |
+```{r fig.width=5, fig.height=5} |
|
232 |
+ggtree(tree, aes(color=branch.length)) + |
|
233 |
+ scale_color_continuous(low="green", high="red") + |
|
234 |
+ theme(legend.position="bottom") |
|
235 |
+``` |
|
236 |
+User can use any feature, including clade posterior and dN/dS _etc._, to scale the color of the tree. |
|
237 |
+ |
|
227 | 238 |
## annotate clade |
228 | 239 |
`r Githubpkg("GuangchuangYu/ggtree")` implements _`annotation_clade`_ and _`annotation_clade2`_ functions to annotate a selected clade with a bar indicating that clade with a corresponding label. |
229 | 240 |
|
... | ... |
@@ -617,12 +628,12 @@ merged_tree <- merge_tree(beast_tree, codeml_tree) |
617 | 628 |
merged_tree |
618 | 629 |
``` |
619 | 630 |
|
620 |
-After merging, all evidences inferred from different tools can be used to annotate the tree simultaneously. In this example, we used 'dN/dS' inferred by CodeML to color the tree and annotate the tree with 'posterior' inferred by BEAST. |
|
631 |
+After merging, all evidences inferred from different tools can be used to annotate the tree simultaneously. In this example, we used 'dN' inferred by CodeML to color the tree and annotate the tree with 'posterior' inferred by BEAST. |
|
621 | 632 |
|
622 | 633 |
```{r fig.width=20, fig.height=26, warning=FALSE} |
623 |
-ggtree(merged_tree, aes(color=dN_vs_dS), time_scale=TRUE, ndigits = 3) + |
|
634 |
+ggtree(merged_tree, aes(color=dN), time_scale=TRUE, ndigits = 3) + |
|
624 | 635 |
geom_text(aes(label=posterior), vjust=.1, hjust=-.1, size=5) + theme_tree2() + |
625 |
- scale_color_continuous(low="steelblue", high="red") |
|
636 |
+ scale_color_continuous(low="green", high="red") + theme(legend.position="right") |
|
626 | 637 |
``` |
627 | 638 |
|
628 | 639 |
|