Browse code

update geom_strip and add nodeid function

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@119673 bc3139a8-67e5-0310-9ffc-ced21a209358

Guangchuang Yu authored on 27/07/2016 04:22:44
Showing 8 changed files

... ...
@@ -1,8 +1,6 @@
1 1
 .git
2 2
 .Rhistory
3 3
 R/.Rhistory
4
-
5
-Makefile
6 4
 Makefile
7 5
 TODO.md
8 6
 README.md
... ...
@@ -1,7 +1,7 @@
1 1
 Package: ggtree
2 2
 Type: Package
3 3
 Title: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data
4
-Version: 1.5.6
4
+Version: 1.5.7
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 grammar of graphics.
... ...
@@ -23,6 +23,7 @@ Suggests:
23 23
     Biostrings,
24 24
     colorspace,
25 25
     EBImage,
26
+    emojifont,
26 27
     knitr,
27 28
     rmarkdown,
28 29
     scales,
... ...
@@ -85,6 +85,7 @@ export(merge_tree)
85 85
 export(msaplot)
86 86
 export(multiplot)
87 87
 export(nodebar)
88
+export(nodeid)
88 89
 export(nodepie)
89 90
 export(open_tree)
90 91
 export(phyPML)
... ...
@@ -1,3 +1,8 @@
1
+CHANGES IN VERSION 1.5.7
2
+------------------------
3
+ o geom_strip now only accept node id as input and support labeling strip <2016-07-27, Wed>
4
+ o nodeid function for converting node label(s) to node id(s) <2016-07-27, Wed> 
5
+ 
1 6
 CHANGES IN VERSION 1.5.6
2 7
 ------------------------
3 8
  o remove dependency of Biostring for installing ggtree <2016-07-21, Thu>
... ...
@@ -43,14 +43,14 @@ geom_strip <- function(taxa1, taxa2, label=NA, offset=0, offset.text=0,
43 43
     if (geom == "text") {
44 44
         ## no fill parameter
45 45
         layer_text <- stat_stripText(taxa1=taxa1, taxa2=taxa2, label=label, offset=offset+offset.text,
46
-                                    align=align, size=fontsize, angle=angle, family=family,
46
+                                    align=align, size=fontsize, barextend=barextend, angle=angle, family=family,
47 47
                                     mapping=mapping, data=data, geom=geom, hjust=hjust,
48 48
                                     position=position, show.legend = show.legend,
49 49
                                     inherit.aes = inherit.aes, na.rm=na.rm, ...)
50 50
         
51 51
     } else {
52 52
         layer_text <- stat_stripText(taxa1=taxa1, taxa2=taxa2, label=label, offset=offset+offset.text,
53
-                                    align=align, size=fontsize, angle=angle, fill=fill,family=family,
53
+                                    align=align, size=fontsize, barextend=barextend, angle=angle, fill=fill,family=family,
54 54
                                     mapping=mapping, data=data, geom=geom, hjust=hjust,
55 55
                                     position=position, show.legend = show.legend,
56 56
                                     inherit.aes = inherit.aes, na.rm=na.rm, ...)
... ...
@@ -65,9 +65,9 @@ geom_strip <- function(taxa1, taxa2, label=NA, offset=0, offset.text=0,
65 65
 
66 66
 stat_stripText <- function(mapping=NULL, data=NULL,
67 67
                            geom="text", position="identity",
68
-                           taxa1, taxa2, label, offset, align, ...,
68
+                           taxa1, taxa2, label, offset, align, barextend, ...,
69 69
                            show.legend=NA, inherit.aes=FALSE, na.rm=FALSE) {
70
-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent,label=~label)
70
+    default_aes <- aes_(x=~x, y=~y, node=~node)
71 71
     if (is.null(mapping)) {
72 72
         mapping <- default_aes
73 73
     } else {
... ...
@@ -86,6 +86,7 @@ stat_stripText <- function(mapping=NULL, data=NULL,
86 86
                       label=label,
87 87
                       offset=offset,
88 88
                       align=align,
89
+                      barextend=barextend,
89 90
                       na.rm=na.rm,
90 91
                       ...)
91 92
           )
... ...
@@ -96,7 +97,7 @@ stat_stripBar <- function(mapping=NULL, data=NULL,
96 97
                           geom="segment", position="identity",
97 98
                           taxa1, taxa2, offset, align, barextend, ...,
98 99
                           show.legend=NA, inherit.aes=FALSE, na.rm=FALSE) {
99
-    default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, label=~label)
100
+    default_aes <- aes_(x=~x, y=~y, node=~node)
100 101
     if (is.null(mapping)) {
101 102
         mapping <- default_aes
102 103
     } else {
... ...
@@ -123,8 +124,8 @@ stat_stripBar <- function(mapping=NULL, data=NULL,
123 124
 
124 125
 StatStripText <- ggproto("StatStripText", Stat,
125 126
                          compute_group = function(self, data, scales, params, taxa1, taxa2,
126
-                                                  label, offset, align) {
127
-                             df <- get_striplabel_position(data, taxa1, taxa2, offset, align, adjustRatio = 1.03)
127
+                                                  label, offset, align, barextend) {
128
+                             df <- get_striplabel_position(data, taxa1, taxa2, offset, align, barextend, adjustRatio = 1.03)
128 129
                              df$y <- mean(c(df$y, df$yend))
129 130
                              df$label <- label
130 131
                              return(df)
... ...
@@ -167,6 +168,9 @@ get_striplabel_position_ <- function(data, taxa1, taxa2, barextend=0) {
167 168
 
168 169
 ## used in geom_strip, geom_taxalink
169 170
 taxa2node <- function(data, taxa) {
171
+    if (! 'label' %in% colnames(data))
172
+        data$label <- NA
173
+
170 174
     idx <- with(data, which(taxa == label | taxa == node))
171 175
 
172 176
     if (length(idx) == 0) {
... ...
@@ -1,3 +1,30 @@
1
+##' convert tip or node label(s) to internal node number
2
+##'
3
+##' 
4
+##' @title nodeid
5
+##' @param x tree object or graphic object return by ggtree
6
+##' @param label tip or node label(s)
7
+##' @return internal node number
8
+##' @export
9
+##' @author Guangchuang Yu
10
+nodeid <- function(x, label) {
11
+    if (is(x, "gg")) 
12
+        return(nodeid.gg(x, label))
13
+    
14
+    nodeid.tree(x, label)
15
+}
16
+
17
+nodeid.tree <- function(tree, label) {
18
+    tr <- get.tree(tree)
19
+    lab <- c(tr$tip.label, tr$node.label)
20
+    match(label, lab)
21
+}
22
+
23
+nodeid.gg <- function(p, label) {
24
+    p$data$node[match(label, p$data$label)]
25
+}
26
+    
27
+
1 28
 reroot_node_mapping <- function(tree, tree2) {
2 29
     root <- getRoot(tree)
3 30
 
... ...
@@ -31,7 +31,6 @@ library("ggplot2")
31 31
 library("ggtree")
32 32
 ```
33 33
 
34
-
35 34
 # Layers that allows subsetting
36 35
 
37 36
 `Subsetting` is not supported in layers defined in `ggplot2`, while it is quite useful in phylogenetic annotation since it allows us to annotate at specific node(s). 
... ...
@@ -182,7 +182,7 @@ ggtree(tree) +
182 182
 `geom_cladelabel` is designed for labelling Monophyletic (Clade) while there are related taxa that are not form a clade. `ggtree` provides `geom_strip` to add a strip/bar to indicate the association with optional label (see [the issue](https://github.com/GuangchuangYu/ggtree/issues/52)).
183 183
 
184 184
 ```{r fig.width=5, fig.height=5, fig.align="center", warning=FALSE}
185
-ggtree(tree) + geom_tiplab() + geom_strip('E', 'G', barsize=2, color='red') + geom_strip('F', 'L', barsize=2, color='blue')
185
+ggtree(tree) + geom_tiplab() + geom_strip(5, 7, barsize=2, color='red') + geom_strip(6, 12, barsize=2, color='blue')
186 186
 ```
187 187
 
188 188
 # taxa connection