Browse code

update according to changes of ggplot2

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

Guangchuang Yu authored on 28/08/2015 13:39:22
Showing 34 changed files

... ...
@@ -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.17
4
+Version: 1.1.18
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
... ...
@@ -26,8 +26,12 @@ export(download.phylopic)
26 26
 export(expand)
27 27
 export(flip)
28 28
 export(geom_aline)
29
-export(geom_hilight)
29
+export(geom_nodepoint)
30
+export(geom_point2)
31
+export(geom_rootpoint)
32
+export(geom_segment2)
30 33
 export(geom_text)
34
+export(geom_text2)
31 35
 export(geom_tiplab)
32 36
 export(geom_tippoint)
33 37
 export(geom_tree)
... ...
@@ -114,27 +118,35 @@ importFrom(ape,which.edge)
114 118
 importFrom(ape,write.tree)
115 119
 importFrom(colorspace,rainbow_hcl)
116 120
 importFrom(ggplot2,"%+replace%")
121
+importFrom(ggplot2,GeomPoint)
122
+importFrom(ggplot2,GeomSegment)
123
+importFrom(ggplot2,GeomText)
117 124
 importFrom(ggplot2,aes)
118 125
 importFrom(ggplot2,aes_string)
119 126
 importFrom(ggplot2,annotate)
120 127
 importFrom(ggplot2,annotation_custom)
121 128
 importFrom(ggplot2,coord_flip)
122 129
 importFrom(ggplot2,coord_polar)
130
+importFrom(ggplot2,draw_key_path)
131
+importFrom(ggplot2,draw_key_point)
132
+importFrom(ggplot2,draw_key_text)
123 133
 importFrom(ggplot2,element_blank)
124 134
 importFrom(ggplot2,element_line)
125 135
 importFrom(ggplot2,element_rect)
126 136
 importFrom(ggplot2,element_text)
127 137
 importFrom(ggplot2,fortify)
128
-importFrom(ggplot2,geom_point)
129 138
 importFrom(ggplot2,geom_rect)
130 139
 importFrom(ggplot2,geom_segment)
131 140
 importFrom(ggplot2,geom_text)
132 141
 importFrom(ggplot2,geom_tile)
133 142
 importFrom(ggplot2,ggplot)
134 143
 importFrom(ggplot2,ggplotGrob)
144
+importFrom(ggplot2,ggproto)
135 145
 importFrom(ggplot2,guide_legend)
136 146
 importFrom(ggplot2,guides)
137 147
 importFrom(ggplot2,labs)
148
+importFrom(ggplot2,layer)
149
+importFrom(ggplot2,position_nudge)
138 150
 importFrom(ggplot2,scale_color_manual)
139 151
 importFrom(ggplot2,scale_fill_discrete)
140 152
 importFrom(ggplot2,scale_fill_gradient)
... ...
@@ -1,3 +1,12 @@
1
+CHANGES IN VERSION 1.1.18
2
+------------------------
3
+ o layout name change to 'rectangular', 'slanted', 'circular'/'fan' for phylogram and cladogram (if branch.length = 'none')
4
+     'unroot' is not changed. <2015-08-28. Fri>
5
+ o implement geom_point2, geom_text2, geom_segment2 to support subsetting <2015-08-28, Fri>
6
+     see https://github.com/hadley/ggplot2/issues/1295
7
+ o update geom_tiplab according to geom_text2 and geom_segment2 <2015-08-28, Fri>
8
+ o add geom_tippoint, geom_nodepoint and geom_rootpoint <2015-08-28, Fri> 
9
+ 
1 10
 CHANGES IN VERSION 1.1.17
2 11
 ------------------------
3 12
  o bug fixed in rm.singleton.newick by adding support of scientific notation in branch length <2015-08-27, Thu>
... ...
@@ -45,7 +45,7 @@ read.beast <- function(file) {
45 45
 ##' beast <- read.beast(file)
46 46
 ##' plot(beast, annotation="length_0.95_HPD", branch.length="none") + theme_tree()
47 47
 setMethod("plot", signature( x= "beast"),
48
-          function(x, layout = "phylogram",
48
+          function(x, layout = "rectangular",
49 49
                    branch.length = "branch.length",
50 50
                    show.tip.label = TRUE,
51 51
                    tip.label.size = 4,
... ...
@@ -108,7 +108,7 @@ setMethod("get.fields", signature(object="codeml"),
108 108
 ##' @exportMethod plot
109 109
 ##' @importFrom ggplot2 aes_string
110 110
 setMethod("plot", signature(x = "codeml"),
111
-          function(x, layout        = "phylogram",
111
+          function(x, layout        = "rectangular",
112 112
                    branch.length    = "mlc.branch.length",
113 113
                    show.tip.label   = TRUE,
114 114
                    tip.label.size   = 4,
... ...
@@ -91,7 +91,7 @@ setMethod("get.fields", signature(object = "codeml_mlc"),
91 91
 ##' @param annotation one of get.fields(x)
92 92
 ##' @param ndigits round digits
93 93
 setMethod("plot", signature(x = "codeml_mlc"),
94
-          function(x, layout        = "phylogram",
94
+          function(x, layout        = "rectangular",
95 95
                    branch.length    = "branch.length",
96 96
                    show.tip.label   = TRUE,
97 97
                    tip.label.size   = 4,
98 98
new file mode 100644
... ...
@@ -0,0 +1,120 @@
1
+
2
+##' add tip point
3
+##'
4
+##' 
5
+##' @title geom_tippoint
6
+##' @inheritParams geom_point2
7
+##' @return tip point layer
8
+##' @export
9
+##' @author Guangchuang Yu
10
+geom_tippoint <- function(mapping = NULL, data = NULL, stat = "identity",
11
+                       position = "identity", na.rm = FALSE,
12
+                          show.legend = NA, inherit.aes = TRUE, ...) {
13
+    isTip <- NULL
14
+    self_mapping <- aes(subset = isTip)
15
+    if (is.null(mapping)) {
16
+        mapping <- self_mapping
17
+    } else {
18
+        mapping %<>% modifyList(self_mapping)
19
+    }
20
+    geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...)    
21
+}
22
+
23
+##' add node point
24
+##'
25
+##' 
26
+##' @title geom_nodepoint
27
+##' @inheritParams geom_point2
28
+##' @return node point layer
29
+##' @export
30
+##' @author Guangchuang Yu
31
+geom_nodepoint <- function(mapping = NULL, data = NULL, stat = "identity",
32
+                       position = "identity", na.rm = FALSE,
33
+                       show.legend = NA, inherit.aes = TRUE, ...) {
34
+    isTip <- NULL
35
+    self_mapping <- aes(subset = !isTip)
36
+    if (is.null(mapping)) {
37
+        mapping <- self_mapping
38
+    } else {
39
+        mapping %<>% modifyList(self_mapping)
40
+    }
41
+    geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...)    
42
+}
43
+
44
+
45
+##' add root point
46
+##'
47
+##' 
48
+##' @title geom_rootpoint
49
+##' @inheritParams geom_point2
50
+##' @return root point layer
51
+##' @export
52
+##' @author Guangchuang Yu
53
+geom_rootpoint <- function(mapping = NULL, data = NULL, stat = "identity",
54
+                           position = "identity", na.rm = FALSE,
55
+                           show.legend = NA, inherit.aes = TRUE, ...) {
56
+    isTip <- node <- parent <- NULL
57
+    self_mapping <- aes(subset = (node == parent))
58
+    if (is.null(mapping)) {
59
+        mapping <- self_mapping
60
+    } else {
61
+        mapping %<>% modifyList(self_mapping)
62
+    }
63
+    geom_point2(mapping, data, stat, position, na.rm, show.legend, inherit.aes, ...)
64
+}
65
+
66
+
67
+##' geom_point2 support aes(subset) via setup_data
68
+##'
69
+##' 
70
+##' @title geom_point2
71
+##' @param mapping aes mapping
72
+##' @param data data
73
+##' @param stat stat
74
+##' @param position position
75
+##' @param na.rm logical
76
+##' @param show.legend logical
77
+##' @param inherit.aes logical
78
+##' @param ... addktional parameter
79
+##' @importFrom ggplot2 layer
80
+##' @export
81
+##' @seealso
82
+##' \link[ggplot2]{geom_point}
83
+##' @return point layer
84
+##' @author Guangchuang Yu
85
+geom_point2 <- function(mapping = NULL, data = NULL, stat = "identity",
86
+                       position = "identity", na.rm = FALSE,
87
+                       show.legend = NA, inherit.aes = TRUE, ...) {
88
+  layer(
89
+    data = data,
90
+    mapping = mapping,
91
+    stat = stat,
92
+    geom = GeomPointGGtree,
93
+    position = position,
94
+    show.legend = show.legend,
95
+    inherit.aes = inherit.aes,
96
+    params = list(
97
+      na.rm = na.rm,
98
+      ...
99
+    )
100
+  )
101
+}
102
+
103
+##' @importFrom ggplot2 ggproto
104
+##' @importFrom ggplot2 GeomPoint
105
+##' @importFrom ggplot2 draw_key_point
106
+GeomPointGGtree <- ggproto("GeomPointGGtree", GeomPoint,
107
+                           setup_data = function(data, params) {
108
+                               data[data$subset,]
109
+                           },
110
+                           
111
+                           draw_panel = function(data, panel_scales, coord, na.rm = FALSE){
112
+                               GeomPoint$draw_panel(data, panel_scales, coord, na.rm)
113
+                           },
114
+                           
115
+                           draw_key = draw_key_point,
116
+                           
117
+                           required_aes = c("x", "y"),
118
+                           default_aes = aes(shape = 19, colour = "black", size = 1.5, fill = NA,
119
+                               alpha = NA, stroke = 0.5)
120
+                           )
0 121
new file mode 100644
... ...
@@ -0,0 +1,85 @@
1
+##' add horizontal align lines
2
+##'
3
+##' 
4
+##' @title geom_aline
5
+##' @param mapping aes mapping
6
+##' @param linetype line type
7
+##' @param size line size
8
+##' @param ... additional parameter
9
+##' @return aline layer
10
+##' @export
11
+##' @author Yu Guangchuang
12
+geom_aline <- function(mapping=NULL, linetype="dotted", size=1, ...) {
13
+    x <- y <- isTip <- NULL
14
+    dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), yend=y, subset=isTip)
15
+    if (!is.null(mapping)) {
16
+        dot_mapping <- modifyList(dot_mapping, mapping)
17
+    }
18
+    
19
+    geom_segment2(dot_mapping,
20
+                  linetype=linetype,
21
+                  size=size, ...)
22
+}
23
+
24
+
25
+
26
+##' geom_segment2 support aes(subset) via setup_data
27
+##'
28
+##' 
29
+##' @title geom_segment2
30
+##' @param mapping aes mapping 
31
+##' @param data data
32
+##' @param stat stat
33
+##' @param position position
34
+##' @param arrow arrow
35
+##' @param lineend lineend
36
+##' @param na.rm logical
37
+##' @param show.legend logical
38
+##' @param inherit.aes logical
39
+##' @param ... additional parameter
40
+##' @importFrom ggplot2 layer
41
+##' @export
42
+##' @seealso
43
+##' \link[ggplot2]{geom_segment}
44
+##' @return add segment layer
45
+##' @author Guangchuang Yu
46
+geom_segment2 <- function(mapping = NULL, data = NULL, stat = "identity",
47
+                         position = "identity", arrow = NULL, lineend = "butt",
48
+                         na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
49
+                         ...) {
50
+  layer(
51
+    data = data,
52
+    mapping = mapping,
53
+    stat = stat,
54
+    geom = GeomSegmentGGtree,
55
+    position = position,
56
+    show.legend = show.legend,
57
+    inherit.aes = inherit.aes,
58
+    params = list(
59
+      arrow = arrow,
60
+      lineend = lineend,
61
+      na.rm = na.rm,
62
+      ...
63
+    )
64
+  )
65
+}
66
+
67
+##' @importFrom ggplot2 GeomSegment
68
+##' @importFrom ggplot2 draw_key_path
69
+GeomSegmentGGtree <- ggproto("GeomSegmentGGtree", GeomSegment,
70
+                          setup_data = function(data, params) {
71
+                              data[data$subset,]
72
+                          },
73
+                          
74
+                          draw_panel = function(data, panel_scales, coord, arrow = NULL,
75
+                              lineend = "butt", na.rm = FALSE) {
76
+
77
+                              GeomSegment$draw_panel(data, panel_scales, coord, arrow,
78
+                                                     lineend, na.rm)
79
+                          },
80
+                          
81
+                          required_aes = c("x", "y", "xend", "yend"),
82
+                          default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
83
+                          
84
+                          draw_key = draw_key_path
85
+                          )
0 86
new file mode 100644
... ...
@@ -0,0 +1,85 @@
1
+##' geom_text2 support aes(subset) via setup_data
2
+##'
3
+##' 
4
+##' @title geom_text2
5
+##' @inheritParams geom_text
6
+##' @return text layer
7
+##' @importFrom ggplot2 layer
8
+##' @importFrom ggplot2 position_nudge
9
+##' @export
10
+##' @seealso
11
+##' \link[ggplot2]{geom_text}
12
+##' @author Guangchuang Yu
13
+geom_text2 <- function(mapping = NULL, data = NULL, stat = "identity",
14
+  position = "identity", parse = FALSE, show.legend = NA, inherit.aes = TRUE,
15
+  ..., nudge_x = 0, nudge_y = 0, check_overlap = FALSE)
16
+{
17
+  if (!missing(nudge_x) || !missing(nudge_y)) {
18
+    if (!missing(position)) {
19
+      stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE)
20
+    }
21
+
22
+    position <- position_nudge(nudge_x, nudge_y)
23
+  }
24
+
25
+  layer(
26
+    data = data,
27
+    mapping = mapping,
28
+    stat = stat,
29
+    geom = GeomTextGGtree,
30
+    position = position,
31
+    show.legend = show.legend,
32
+    inherit.aes = inherit.aes,
33
+    params = list(
34
+      parse = parse,
35
+      check_overlap = check_overlap,
36
+      ...
37
+    )
38
+  )
39
+}
40
+
41
+##' text annotations
42
+##' @export
43
+##' @rdname geom_text
44
+##' @param mapping the aesthetic mapping
45
+##' @param data A layer specific dataset -
46
+##'             only needed if you want to override he plot defaults.
47
+##' @param stat The statistical transformation to use on the data for this layer
48
+##' @param position The position adjustment to use for overlapping points on this layer
49
+##' @param parse if TRUE, the labels will be passd into expressions
50
+##' @param show.legend logical
51
+##' @param inherit.aes logical
52
+##' @param ... other arguments passed on to 'layer'
53
+##' @param nudge_x horizontal adjustment
54
+##' @param nudge_y vertical adjustment
55
+##' @param check_overlap if TRUE, text that overlaps previous text in the same layer will not be plotted
56
+##' @source
57
+##' This is just the imported function
58
+##' from the ggplot2 package. The documentation you should
59
+##' read for the geom_text function can be found here: \link[ggplot2]{geom_text}
60
+##'
61
+##' @seealso
62
+##' \link[ggplot2]{geom_text}
63
+geom_text <- ggplot2::geom_text
64
+
65
+
66
+##' @importFrom ggplot2 GeomText
67
+##' @importFrom ggplot2 draw_key_text
68
+GeomTextGGtree <- ggproto("GeomTextGGtree", GeomText,
69
+                          setup_data = function(data, params) {
70
+                              data[data$subset,]
71
+                          },
72
+                          
73
+                          draw_panel = function(data, panel_scales, coord, parse = FALSE,
74
+                              na.rm = FALSE, check_overlap = FALSE) {
75
+                              GeomText$draw_panel(data, panel_scales, coord, parse,
76
+                                                  na.rm, check_overlap)
77
+                          },
78
+
79
+                          required_aes = c("x", "y", "label"),
80
+                          
81
+                          default_aes = aes(colour = "black", size = 3.88, angle = 0, hjust = 0.5,
82
+                              vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2),
83
+                          
84
+                          draw_key = draw_key_text
85
+                          )
0 86
new file mode 100644
... ...
@@ -0,0 +1,54 @@
1
+##' add tip label layer
2
+##'
3
+##' 
4
+##' @title geom_tiplab 
5
+##' @param mapping aes mapping
6
+##' @param hjust horizontal adjustment
7
+##' @param align align tip lab or not, logical
8
+##' @param linetype linetype for adding line if align = TRUE
9
+##' @param linesize line size of line if align = TRUE
10
+##' @param ... additional parameter
11
+##' @return tip label layer
12
+##' @importFrom ggplot2 geom_text
13
+##' @export
14
+##' @author Yu Guangchuang
15
+##' @examples
16
+##' require(ape)
17
+##' tr <- rtree(10)
18
+##' ggtree(tr) + geom_tiplab()
19
+geom_tiplab <- function(mapping=NULL, hjust = 0, align = FALSE, linetype = "dotted", linesize=1, ...) {
20
+    x <- y <- label <- isTip <- NULL
21
+    if (align == TRUE) {
22
+        self_mapping <- aes(x = max(x) + diff(range(x))/200, y = y, label = label, subset= isTip)
23
+    }
24
+    else {
25
+        self_mapping <- aes(x = x + diff(range(x))/200, y= y, label = label, subset= isTip)
26
+    }
27
+
28
+    if (is.null(mapping)) {
29
+        text_mapping <- self_mapping          
30
+    } else {
31
+        text_mapping <- modifyList(self_mapping, mapping)
32
+    }
33
+
34
+    dot_mapping <- NULL
35
+    if (align && (!is.na(linetype) && !is.null(linetype))) {
36
+        dot_mapping <- aes(xend=x+diff(range(x))/200, x=max(x), y=y, yend=y, subset=isTip)
37
+        if (!is.null(mapping)) {
38
+            dot_mapping <- modifyList(dot_mapping, mapping)
39
+        }
40
+    } 
41
+    
42
+    list(
43
+        geom_text2(mapping=text_mapping, 
44
+                   hjust = hjust, ...),
45
+        if (!is.null(dot_mapping))
46
+            geom_segment2(mapping=dot_mapping,
47
+                          linetype = linetype,
48
+                          size = linesize, ...)
49
+        )
50
+}
51
+
52
+
53
+
54
+
... ...
@@ -27,26 +27,3 @@ aes <- ggplot2::aes
27 27
 ##' \link[ggplot2]{ggplotGrob}
28 28
 ggplotGrob <- ggplot2::ggplotGrob
29 29
 
30
-##' text annotations
31
-##' @export
32
-##' @rdname geom_text
33
-##' @param mapping the aesthetic mapping
34
-##' @param data A layer specific dataset -
35
-##'             only needed if you want to override he plot defaults.
36
-##' @param stat The statistical transformation to use on the data for this layer
37
-##' @param position The position adjustment to use for overlapping points on this layer
38
-##' @param parse if TRUE, the labels will be passd into expressions
39
-##' @param show.legend logical
40
-##' @param inherit.aes logical
41
-##' @param ... other arguments passed on to 'layer'
42
-##' @param nudge_x horizontal adjustment
43
-##' @param nudge_y vertical adjustment
44
-##' @param check_overlap if TRUE, text that overlaps previous text in the same layer will not be plotted
45
-##' @source
46
-##' This is just the imported function
47
-##' from the ggplot2 package. The documentation you should
48
-##' read for the geom_text function can be found here: \link[ggplot2]{geom_text}
49
-##'
50
-##' @seealso
51
-##' \link[ggplot2]{geom_text}
52
-geom_text <- ggplot2::geom_text
... ...
@@ -5,11 +5,13 @@
5 5
 ##' @param tr phylo object
6 6
 ##' @param mapping aes mapping
7 7
 ##' @param showDistance add distance legend, logical
8
-##' @param layout one of phylogram, dendrogram, cladogram, fan, radial and unrooted
8
+##' @param layout one of 'rectangular', 'slanted', 'fan'/'circular', 'radial' or 'unrooted'
9
+##' @param time_scale logical
9 10
 ##' @param yscale y scale
11
+##' @param yscale_mapping yscale mapping for category variable
10 12
 ##' @param ladderize logical
11 13
 ##' @param right logical
12
-##' @param branch.length variable for scaling branch 
14
+##' @param branch.length variable for scaling branch, if 'none' draw cladogram
13 15
 ##' @param ndigits number of digits to round numerical annotation variable
14 16
 ##' @param ... additional parameter
15 17
 ##' @return tree
... ...
@@ -30,25 +32,26 @@
30 32
 ggtree <- function(tr,
31 33
                    mapping = NULL,
32 34
                    showDistance=FALSE,
33
-                   layout="phylogram",
35
+                   layout="rectangular",
36
+                   time_scale = FALSE,
34 37
                    yscale="none",
38
+                   yscale_mapping = NULL,
35 39
                    ladderize = TRUE, right=FALSE,
36 40
                    branch.length="branch.length",
37 41
                    ndigits = NULL, ...) {
42
+
43
+    layout %<>% match.arg(c("rectangular", "slanted", "fan", "circular", "radial", "unrooted"))
44
+    
38 45
     d <- x <- y <- NULL
39 46
     if(yscale != "none") {
40 47
         ## for 2d tree
41
-        layout <- "cladogram"
48
+        layout <- "slanted"
42 49
     }
43
-    if (layout == "fan") {
44
-        ## layout <- "phylogram"
45
-        type <- "fan"
50
+    if (layout == "fan" || layout == "circular") {
51
+        type <- "circular"
46 52
     } else if (layout == "radial") {
47
-        layout <- "cladogram"
53
+        layout <- "slanted"
48 54
         type <- "radial"
49
-    } else if (layout == "dendrogram") {
50
-        layout <- "phylogram"
51
-        type <- "dendrogram"
52 55
     } else {
53 56
         type <- "none"
54 57
     }
... ...
@@ -59,17 +62,17 @@ ggtree <- function(tr,
59 62
     }
60 63
     p <- ggplot(tr, mapping=mapping,
61 64
                 layout        = layout,
65
+                time_scale    = time_scale,
62 66
                 yscale        = yscale,
67
+                yscale_mapping= yscale_mapping,
63 68
                 ladderize     = ladderize,
64 69
                 right         = right,
65 70
                 branch.length = branch.length,
66 71
                 ndigits       = ndigits, ...)
67
-
72
+    
68 73
     p <- p + geom_tree(layout, ...) + xlab("") + ylab("") + theme_tree2()
69 74
     
70
-    if (type == "dendrogram") {
71
-        p <- p + scale_x_reverse() + coord_flip()
72
-    } else if (type == "fan" || type == "radial") {
75
+    if (type == "circular" || type == "radial") {
73 76
         p <- p + coord_polar(theta = "y")
74 77
         ## refer to: https://github.com/GuangchuangYu/ggtree/issues/6
75 78
         p <- p + scale_y_continuous(limits=c(0, max(p$data$y)))
... ...
@@ -91,7 +94,7 @@ ggtree <- function(tr,
91 94
 ##'
92 95
 ##' 
93 96
 ##' @title geom_tree
94
-##' @param layout one of phylogram, cladogram
97
+##' @param layout one of 'rectangular', 'slanted', 'circular', 'radial' or 'unrooted'
95 98
 ##' @param ... additional parameter
96 99
 ##' @return tree layer
97 100
 ##' @importFrom ggplot2 geom_segment
... ...
@@ -103,10 +106,10 @@ ggtree <- function(tr,
103 106
 ##' tr <- rtree(10)
104 107
 ##' require(ggplot2)
105 108
 ##' ggplot(tr) + geom_tree()
106
-geom_tree <- function(layout="phylogram", ...) {
109
+geom_tree <- function(layout="rectangular", ...) {
107 110
     x <- y <- parent <- NULL
108 111
     lineend  = "round"
109
-    if (layout == "phylogram" || layout == "fan") {
112
+    if (layout == "rectangular" || layout == "fan" || layout == "circular") {
110 113
         list(
111 114
             geom_segment(aes(x    = x[parent],
112 115
                              xend = x,
... ...
@@ -120,7 +123,7 @@ geom_tree <- function(layout="phylogram", ...) {
120 123
                              yend = y),
121 124
                          lineend  = lineend, ...)
122 125
             )
123
-    } else if (layout == "cladogram" || layout == "unrooted") {
126
+    } else if (layout == "slanted" || layout == "radial" || layout == "unrooted") {
124 127
         geom_segment(aes(x    = x[parent],
125 128
                          xend = x,
126 129
                          y    = y[parent],
... ...
@@ -139,7 +142,6 @@ geom_tree <- function(layout="phylogram", ...) {
139 142
 ##' @param ... additional parameters
140 143
 ##' @return ggplot layer
141 144
 ##' @importFrom ape extract.clade
142
-##' @export
143 145
 ##' @author Guangchuang Yu
144 146
 geom_hilight <- function(tree_object, node, ...) {
145 147
     clade <- extract.clade(get.tree(tree_object), node)
... ...
@@ -152,100 +154,6 @@ geom_hilight <- function(tree_object, node, ...) {
152 154
 }
153 155
 
154 156
 
155
-##' add tip label layer
156
-##'
157
-##' 
158
-##' @title geom_tiplab 
159
-##' @param mapping aes mapping
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 linesize line size of line if align = TRUE
164
-##' @param ... additional parameter
165
-##' @return tip label layer
166
-##' @importFrom ggplot2 geom_text
167
-##' @export
168
-##' @author Yu Guangchuang
169
-##' @examples
170
-##' require(ape)
171
-##' tr <- rtree(10)
172
-##' ggtree(tr) + geom_tiplab()
173
-geom_tiplab <- function(mapping=NULL, hjust = 0, align = FALSE, linetype = "dotted", linesize=1, ...) {
174
-    x <- y <- label <- isTip <- NULL
175
-    if (align == TRUE) {
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          
184
-    } else {
185
-        text_mapping <- modifyList(self_mapping, mapping)
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 = linesize, ...)
205
-        )
206
-}
207
-
208
-
209
-
210
-##' add horizontal align lines
211
-##'
212
-##' 
213
-##' @title geom_aline
214
-##' @param linetype line type
215
-##' @param ... additional parameter
216
-##' @return aline layer
217
-##' @export
218
-##' @author Yu Guangchuang
219
-##' @examples
220
-##' require(ape)
221
-##' tr <- rtree(10)
222
-##' ggtree(tr) + geom_tiplab(align=TRUE) + geom_aline()
223
-geom_aline <- function(linetype="dashed", ...) {
224
-    x <- y <- isTip <- NULL
225
-    geom_segment(aes(x=ifelse(x==max(x), x, x*1.02),
226
-                     xend=max(x), yend=y),
227
-                 subset=.(isTip), linetype=linetype, ...)
228
-}
229
-
230
-##' add points layer of tips 
231
-##'
232
-##' 
233
-##' @title geom_tippoint 
234
-##' @param ... additional parameter
235
-##' @return tip point layer
236
-##' @importFrom ggplot2 geom_point
237
-##' @export
238
-##' @author Yu Guangchuang
239
-##' @examples
240
-##' require(ape)
241
-##' tr <- rtree(10)
242
-##' ggtree(tr) + geom_tippoint()
243
-geom_tippoint <- function(...) {
244
-    isTip <- NULL
245
-    geom_point(subset=.(isTip), ...)
246
-}
247
-
248
-
249 157
 ##' tree theme
250 158
 ##'
251 159
 ##' 
... ...
@@ -72,7 +72,7 @@ read.hyphy <- function(nwk, ancseq, tip.fasfile=NULL) {
72 72
 ##' @rdname plot-methods
73 73
 ##' @exportMethod plot
74 74
 setMethod("plot", signature(x = "hyphy"),
75
-          function(x, layout        = "phylogram",
75
+          function(x, layout        = "rectangular",
76 76
                    show.tip.label   = TRUE,
77 77
                    tip.label.size   = 4,
78 78
                    tip.label.hjust  = -0.1,
... ...
@@ -157,7 +157,7 @@ setMethod("get.tree", signature(object = "paml_rst"),
157 157
 ##' @rdname plot-methods
158 158
 ##' @exportMethod plot
159 159
 setMethod("plot", signature(x = "paml_rst"),
160
-          function(x, layout        = "phylogram",
160
+          function(x, layout        = "rectangular",
161 161
                    show.tip.label   = TRUE,
162 162
                    tip.label.size   = 4,
163 163
                    tip.label.hjust  = -0.1,
... ...
@@ -180,8 +180,7 @@ gzoom.phylo <- function(phy, focus, subtree=FALSE, widths=c(.3, .7)) {
180 180
 ##' library("ggplot2")
181 181
 ##' nwk <- system.file("extdata", "sample.nwk", package="ggtree")
182 182
 ##' tree <- read.tree(nwk)
183
-##' p <- ggtree(tree) + geom_point(subset=.(!isTip), 
184
-##'         	       color="#b5e521", alpha=1/4, size=10)
183
+##' p <- ggtree(tree) + geom_tippoint(color="#b5e521", alpha=1/4, size=10)
185 184
 ##' p %<% rtree(30)
186 185
 `%<%` <- function(pg, x) {
187 186
     if (! is.tree(x)) {
... ...
@@ -586,7 +585,7 @@ getXcoord <- function(tr) {
586 585
     return(x)
587 586
 }
588 587
 
589
-getXYcoord_cladogram <- function(tr) {
588
+getXYcoord_slanted <- function(tr) {
590 589
     
591 590
     edge <- tr$edge
592 591
     parent <- edge[,1]
... ...
@@ -846,7 +845,7 @@ getYcoord_scale_category <- function(tr, df, yscale, yscale_mapping=NULL, ...) {
846 845
 }
847 846
 
848 847
 
849
-add_angle_cladogram <- function(res) {
848
+add_angle_slanted <- function(res) {
850 849
     dy <- (res[, "y"] - res[res$parent, "y"]) / diff(range(res[, "y"]))
851 850
     dx <- (res[, "x"] - res[res$parent, "x"]) / diff(range(res[, "x"]))
852 851
     theta <- atan(dy/dx)
... ...
@@ -105,7 +105,7 @@ rm.singleton.newick <- function(nwk, outfile = NULL) {
105 105
 ##' @method fortify beast
106 106
 ##' @export
107 107
 fortify.beast <- function(model, data,
108
-                          layout    = "phylogram",
108
+                          layout    = "rectangular",
109 109
                           yscale    = "none",
110 110
                           ladderize = TRUE,
111 111
                           right     =FALSE,
... ...
@@ -213,7 +213,7 @@ scaleX_by_time <- function(df) {
213 213
 ##' @method fortify codeml
214 214
 ##' @export
215 215
 fortify.codeml <- function(model, data,
216
-                           layout        = "phylogram",
216
+                           layout        = "rectangular",
217 217
                            yscale        = "none",
218 218
                            ladderize     = TRUE,
219 219
                            right         = FALSE,
... ...
@@ -257,7 +257,7 @@ fortify.codeml <- function(model, data,
257 257
 ##' @method fortify codeml_mlc
258 258
 ##' @export
259 259
 fortify.codeml_mlc <- function(model, data,
260
-                               layout        = "phylogram",
260
+                               layout        = "rectangular",
261 261
                                yscale        = "none",
262 262
                                ladderize     = TRUE,
263 263
                                right         = FALSE,
... ...
@@ -296,7 +296,7 @@ merge_phylo_anno.codeml_mlc <- function(df, dNdS, ndigits = NULL) {
296 296
 }
297 297
 
298 298
 fortify.codeml_mlc_ <- function(model, data,
299
-                                layout        = "phylogram",
299
+                                layout        = "rectangular",
300 300
                                 ladderize     = TRUE,
301 301
                                 right         = FALSE,
302 302
                                 branch.length = "branch.length",                           
... ...
@@ -324,7 +324,7 @@ fortify.codeml_mlc_ <- function(model, data,
324 324
     
325 325
 ##' @method fortify paml_rst
326 326
 ##' @export
327
-fortify.paml_rst <- function(model, data, layout = "phylogram", yscale="none",
327
+fortify.paml_rst <- function(model, data, layout = "rectangular", yscale="none",
328 328
                              ladderize=TRUE, right=FALSE, ...) {
329 329
     df <- fortify.phylo(model@phylo, data, layout, ladderize, right, ...)
330 330
     df <- merge_phylo_anno.paml_rst(df, model)
... ...
@@ -351,7 +351,7 @@ fortify.hyphy <- fortify.paml_rst
351 351
 ##' @importFrom ape read.tree
352 352
 ##' @export
353 353
 fortify.jplace <- function(model, data,
354
-                           layout="phylogram", yscale="none",
354
+                           layout="rectangular", yscale="none",
355 355
                            ladderize=TRUE, right=FALSE, ...) {
356 356
     df <- get.treeinfo(model, layout, ladderize, right, ...)
357 357
     place <- get.placements(model, by="best")
... ...
@@ -383,8 +383,8 @@ scaleY <- function(phylo, df, yscale, layout, ...) {
383 383
     }
384 384
     
385 385
     df[, "y"] <- y
386
-    if (layout == "cladogram") {
387
-        df <- add_angle_cladogram(df)
386
+    if (layout == "slanted") {
387
+        df <- add_angle_slanted(df)
388 388
     }
389 389
     return(df)
390 390
 }
... ...
@@ -392,7 +392,7 @@ scaleY <- function(phylo, df, yscale, layout, ...) {
392 392
 
393 393
 ##' @method fortify phylo4
394 394
 ##' @export
395
-fortify.phylo4 <- function(model, data, layout="phylogram", yscale="none",
395
+fortify.phylo4 <- function(model, data, layout="rectangular", yscale="none",
396 396
                            ladderize=TRUE, right=FALSE, ...) {
397 397
     phylo <- as.phylo.phylo4(model)
398 398
     df <- fortify.phylo(phylo, data,
... ...
@@ -437,7 +437,7 @@ as.phylo.phylo4 <- function(phylo4) {
437 437
 ##' @method fortify phylo
438 438
 ##' @export
439 439
 ##' @author Yu Guangchuang
440
-fortify.phylo <- function(model, data, layout="phylogram", 
440
+fortify.phylo <- function(model, data, layout="rectangular", 
441 441
                           ladderize=TRUE, right=FALSE, ...) {
442 442
     if (ladderize == TRUE) {
443 443
         tree <- ladderize(model, right=right)
... ...
@@ -451,8 +451,8 @@ fortify.phylo <- function(model, data, layout="phylogram",
451 451
     rownames(df) <- df$node
452 452
     cn <- colnames(df)
453 453
     colnames(df)[grep("length", cn)] <- "branch.length"
454
-    if(layout == "cladogram") {
455
-        df <- add_angle_cladogram(df)
454
+    if(layout == "slanted") {
455
+        df <- add_angle_slanted(df)
456 456
     }
457 457
     aa <- names(attributes(tree))
458 458
     group <- aa[ ! aa %in% c("names", "class", "order", "reroot", "node_map")]
... ...
@@ -477,14 +477,14 @@ fortify.phylo <- function(model, data, layout="phylogram",
477 477
 ##' @export
478 478
 ##' @author Yu Guangchuang
479 479
 as.data.frame.phylo <- function(x, row.names, optional,
480
-                                layout="phylogram", ...) {
480
+                                layout="rectangular", ...) {
481 481
     if (layout == "unrooted") {
482 482
         return(layout.unrooted(x))
483 483
     } 
484 484
     as.data.frame.phylo_(x, layout, ...)
485 485
 }
486 486
 
487
-as.data.frame.phylo_ <- function(x, layout="phylogram",
487
+as.data.frame.phylo_ <- function(x, layout="rectangular",
488 488
                                  branch.length="branch.length", ...) {
489 489
     tip.label <- x[["tip.label"]]
490 490
     Ntip <- length(tip.label)
... ...
@@ -531,7 +531,7 @@ as.data.frame.phylo_ <- function(x, layout="phylogram",
531 531
     ## add branch mid position
532 532
     res <- calculate_branch_mid(res)
533 533
     
534
-    if (layout == "fan") {
534
+    if (layout == "circular") {
535 535
         idx <- match(1:N, order(res$y))
536 536
         angle <- -360/(N+1) * 1:N
537 537
         angle <- angle[idx]
538 538
new file mode 100644
539 539
Binary files /dev/null and b/inst/extdata/phylopic1.png differ
540 540
new file mode 100644
541 541
Binary files /dev/null and b/inst/extdata/phylopic2.png differ
... ...
@@ -4,7 +4,7 @@
4 4
 \alias{as.data.frame.phylo}
5 5
 \title{as.data.frame}
6 6
 \usage{
7
-\method{as.data.frame}{phylo}(x, row.names, optional, layout = "phylogram",
7
+\method{as.data.frame}{phylo}(x, row.names, optional, layout = "rectangular",
8 8
   ...)
9 9
 }
10 10
 \arguments{
... ...
@@ -4,8 +4,8 @@
4 4
 \alias{fortify.phylo}
5 5
 \title{fortify}
6 6
 \usage{
7
-\method{fortify}{phylo}(model, data, layout = "phylogram", ladderize = TRUE,
8
-  right = FALSE, ...)
7
+\method{fortify}{phylo}(model, data, layout = "rectangular",
8
+  ladderize = TRUE, right = FALSE, ...)
9 9
 }
10 10
 \arguments{
11 11
 \item{model}{phylo object}
... ...
@@ -1,14 +1,18 @@
1 1
 % Generated by roxygen2 (4.1.1): do not edit by hand
2
-% Please edit documentation in R/ggtree.R
2
+% Please edit documentation in R/geom_segment.R
3 3
 \name{geom_aline}
4 4
 \alias{geom_aline}
5 5
 \title{geom_aline}
6 6
 \usage{
7
-geom_aline(linetype = "dashed", ...)
7
+geom_aline(mapping = NULL, linetype = "dotted", size = 1, ...)
8 8
 }
9 9
 \arguments{
10
+\item{mapping}{aes mapping}
11
+
10 12
 \item{linetype}{line type}
11 13
 
14
+\item{size}{line size}
15
+
12 16
 \item{...}{additional parameter}
13 17
 }
14 18
 \value{
... ...
@@ -17,11 +21,6 @@ aline layer
17 21
 \description{
18 22
 add horizontal align lines
19 23
 }
20
-\examples{
21
-require(ape)
22
-tr <- rtree(10)
23
-ggtree(tr) + geom_tiplab(align=TRUE) + geom_aline()
24
-}
25 24
 \author{
26 25
 Yu Guangchuang
27 26
 }
28 27
new file mode 100644
... ...
@@ -0,0 +1,37 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/geom_point.R
3
+\name{geom_nodepoint}
4
+\alias{geom_nodepoint}
5
+\title{geom_nodepoint}
6
+\usage{
7
+geom_nodepoint(mapping = NULL, data = NULL, stat = "identity",
8
+  position = "identity", na.rm = FALSE, show.legend = NA,
9
+  inherit.aes = TRUE, ...)
10
+}
11
+\arguments{
12
+\item{mapping}{aes mapping}
13
+
14
+\item{data}{data}
15
+
16
+\item{stat}{stat}
17
+
18
+\item{position}{position}
19
+
20
+\item{na.rm}{logical}
21
+
22
+\item{show.legend}{logical}
23
+
24
+\item{inherit.aes}{logical}
25
+
26
+\item{...}{addktional parameter}
27
+}
28
+\value{
29
+node point layer
30
+}
31
+\description{
32
+add node point
33
+}
34
+\author{
35
+Guangchuang Yu
36
+}
37
+
0 38
new file mode 100644
... ...
@@ -0,0 +1,40 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/geom_point.R
3
+\name{geom_point2}
4
+\alias{geom_point2}
5
+\title{geom_point2}
6
+\usage{
7
+geom_point2(mapping = NULL, data = NULL, stat = "identity",
8
+  position = "identity", na.rm = FALSE, show.legend = NA,
9
+  inherit.aes = TRUE, ...)
10
+}
11
+\arguments{
12
+\item{mapping}{aes mapping}
13
+
14
+\item{data}{data}
15
+
16
+\item{stat}{stat}
17
+
18
+\item{position}{position}
19
+
20
+\item{na.rm}{logical}
21
+
22
+\item{show.legend}{logical}
23
+
24
+\item{inherit.aes}{logical}
25
+
26
+\item{...}{addktional parameter}
27
+}
28
+\value{
29
+point layer
30
+}
31
+\description{
32
+geom_point2 support aes(subset) via setup_data
33
+}
34
+\author{
35
+Guangchuang Yu
36
+}
37
+\seealso{
38
+\link[ggplot2]{geom_point}
39
+}
40
+
0 41
new file mode 100644
... ...
@@ -0,0 +1,37 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/geom_point.R
3
+\name{geom_rootpoint}
4
+\alias{geom_rootpoint}
5
+\title{geom_rootpoint}
6
+\usage{
7
+geom_rootpoint(mapping = NULL, data = NULL, stat = "identity",
8
+  position = "identity", na.rm = FALSE, show.legend = NA,
9
+  inherit.aes = TRUE, ...)
10
+}
11
+\arguments{
12
+\item{mapping}{aes mapping}
13
+
14
+\item{data}{data}
15
+
16
+\item{stat}{stat}
17
+
18
+\item{position}{position}
19
+
20
+\item{na.rm}{logical}
21
+
22
+\item{show.legend}{logical}
23
+
24
+\item{inherit.aes}{logical}
25
+
26
+\item{...}{addktional parameter}
27
+}
28
+\value{
29
+root point layer
30
+}
31
+\description{
32
+add root point
33
+}
34
+\author{
35
+Guangchuang Yu
36
+}
37
+
0 38
new file mode 100644
... ...
@@ -0,0 +1,44 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/geom_segment.R
3
+\name{geom_segment2}
4
+\alias{geom_segment2}
5
+\title{geom_segment2}
6
+\usage{
7
+geom_segment2(mapping = NULL, data = NULL, stat = "identity",
8
+  position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE,
9
+  show.legend = NA, inherit.aes = TRUE, ...)
10
+}
11
+\arguments{
12
+\item{mapping}{aes mapping}
13
+
14
+\item{data}{data}
15
+
16
+\item{stat}{stat}
17
+
18
+\item{position}{position}
19
+
20
+\item{arrow}{arrow}
21
+
22
+\item{lineend}{lineend}
23
+
24
+\item{na.rm}{logical}
25
+
26
+\item{show.legend}{logical}
27
+
28
+\item{inherit.aes}{logical}
29
+
30
+\item{...}{additional parameter}
31
+}
32
+\value{
33
+add segment layer
34
+}
35
+\description{
36
+geom_segment2 support aes(subset) via setup_data
37
+}
38
+\author{
39
+Guangchuang Yu
40
+}
41
+\seealso{
42
+\link[ggplot2]{geom_segment}
43
+}
44
+
... ...
@@ -1,5 +1,5 @@
1 1
 % Generated by roxygen2 (4.1.1): do not edit by hand
2
-% Please edit documentation in R/ggplot2.R
2
+% Please edit documentation in R/geom_text.R
3 3
 \name{geom_text}
4 4
 \alias{geom_text}
5 5
 \title{text annotations}
6 6
new file mode 100644
... ...
@@ -0,0 +1,48 @@
1
+% Generated by roxygen2 (4.1.1): do not edit by hand
2
+% Please edit documentation in R/geom_text.R
3
+\name{geom_text2}
4
+\alias{geom_text2}
5
+\title{geom_text2}
6
+\usage{
7
+geom_text2(mapping = NULL, data = NULL, stat = "identity",
8
+  position = "identity", parse = FALSE, show.legend = NA,
9
+  inherit.aes = TRUE, ..., nudge_x = 0, nudge_y = 0,
10
+  check_overlap = FALSE)
11
+}
12
+\arguments{
13
+\item{mapping}{the aesthetic mapping}
14
+
15
+\item{data}{A layer specific dataset -
16
+only needed if you want to override he plot defaults.}
17
+
18
+\item{stat}{The statistical transformation to use on the data for this layer}
19
+
20
+\item{position}{The position adjustment to use for overlapping points on this layer}
21
+
22
+\item{parse}{if TRUE, the labels will be passd into expressions}
23
+
24
+\item{show.legend}{logical}
25
+
26
+\item{inherit.aes}{logical}
27
+
28
+\item{...}{other arguments passed on to 'layer'}
29
+
30
+\item{nudge_x}{horizontal adjustment}
31
+
32
+\item{nudge_y}{vertical adjustment}
33
+
34
+\item{check_overlap}{if TRUE, text that overlaps previous text in the same layer will not be plotted}
35
+}
36
+\value{
37
+text layer
38
+}
39
+\description{
40
+geom_text2 support aes(subset) via setup_data
41
+}
42
+\author{
43
+Guangchuang Yu
44
+}
45
+\seealso{
46
+\link[ggplot2]{geom_text}
47
+}
48
+
... ...
@@ -1,5 +1,5 @@
1 1
 % Generated by roxygen2 (4.1.1): do not edit by hand
2
-% Please edit documentation in R/ggtree.R
2
+% Please edit documentation in R/geom_tiplab.R
3 3
 \name{geom_tiplab}
4 4
 \alias{geom_tiplab}
5 5
 \title{geom_tiplab}
... ...
@@ -1,26 +1,37 @@
1 1
 % Generated by roxygen2 (4.1.1): do not edit by hand
2
-% Please edit documentation in R/ggtree.R
2
+% Please edit documentation in R/geom_point.R
3 3
 \name{geom_tippoint}
4 4
 \alias{geom_tippoint}
5 5
 \title{geom_tippoint}
6 6
 \usage{
7
-geom_tippoint(...)
7
+geom_tippoint(mapping = NULL, data = NULL, stat = "identity",
8
+  position = "identity", na.rm = FALSE, show.legend = NA,
9
+  inherit.aes = TRUE, ...)
8 10
 }
9 11
 \arguments{
10
-\item{...}{additional parameter}
12
+\item{mapping}{aes mapping}
13
+
14
+\item{data}{data}
15
+
16
+\item{stat}{stat}
17
+
18
+\item{position}{position}
19
+
20
+\item{na.rm}{logical}
21
+
22
+\item{show.legend}{logical}
23
+
24
+\item{inherit.aes}{logical}
25
+
26
+\item{...}{addktional parameter}
11 27
 }
12 28
 \value{
13 29
 tip point layer
14 30
 }
15 31
 \description{
16
-add points layer of tips
17
-}
18
-\examples{
19
-require(ape)
20
-tr <- rtree(10)
21
-ggtree(tr) + geom_tippoint()
32
+add tip point
22 33
 }
23 34
 \author{
24
-Yu Guangchuang
35
+Guangchuang Yu
25 36
 }
26 37
 
... ...
@@ -4,10 +4,10 @@
4 4
 \alias{geom_tree}
5 5
 \title{geom_tree}
6 6
 \usage{
7
-geom_tree(layout = "phylogram", ...)
7
+geom_tree(layout = "rectangular", ...)
8 8
 }
9 9
 \arguments{
10
-\item{layout}{one of phylogram, cladogram}
10
+\item{layout}{one of 'rectangular', 'slanted', 'circular', 'radial' or 'unrooted'}
11 11
 
12 12
 \item{...}{additional parameter}
13 13
 }
... ...
@@ -8,9 +8,10 @@
8 8
 \title{visualizing phylogenetic tree and heterogenous associated data based on grammar of graphics
9 9
 \code{ggtree} provides functions for visualizing phylogenetic tree and its associated data in R.}
10 10
 \usage{
11
-ggtree(tr, mapping = NULL, showDistance = FALSE, layout = "phylogram",
12
-  yscale = "none", ladderize = TRUE, right = FALSE,
13
-  branch.length = "branch.length", ndigits = NULL, ...)
11
+ggtree(tr, mapping = NULL, showDistance = FALSE, layout = "rectangular",
12
+  time_scale = FALSE, yscale = "none", yscale_mapping = NULL,
13
+  ladderize = TRUE, right = FALSE, branch.length = "branch.length",
14
+  ndigits = NULL, ...)
14 15
 }
15 16
 \arguments{
16 17
 \item{tr}{phylo object}
... ...
@@ -19,15 +20,19 @@ ggtree(tr, mapping = NULL, showDistance = FALSE, layout = "phylogram",
19 20
 
20 21
 \item{showDistance}{add distance legend, logical}
21 22
 
22
-\item{layout}{one of phylogram, dendrogram, cladogram, fan, radial and unrooted}
23
+\item{layout}{one of 'rectangular', 'slanted', 'fan'/'circular', 'radial' or 'unrooted'}
24
+
25
+\item{time_scale}{logical}
23 26
 
24 27
 \item{yscale}{y scale}
25 28
 
29
+\item{yscale_mapping}{yscale mapping for category variable}
30
+
26 31
 \item{ladderize}{logical}
27 32
 
28 33
 \item{right}{logical}
29 34
 
30
-\item{branch.length}{variable for scaling branch}
35
+\item{branch.length}{variable for scaling branch, if 'none' draw cladogram}
31 36
 
32 37
 \item{ndigits}{number of digits to round numerical annotation variable}
33 38
 
... ...
@@ -10,30 +10,30 @@
10 10
 \alias{plot,paml_rst,ANY-method}
11 11
 \title{plot method}
12 12
 \usage{
13
-\S4method{plot}{beast,ANY}(x, layout = "phylogram",
13
+\S4method{plot}{beast,ANY}(x, layout = "rectangular",
14 14
   branch.length = "branch.length", show.tip.label = TRUE,
15 15
   tip.label.size = 4, tip.label.hjust = -0.1, position = "branch",
16 16
   annotation = "rate", ndigits = 2, annotation.size = 3,
17 17
   annotation.color = "black", ...)
18 18
 
19
-\S4method{plot}{codeml,ANY}(x, layout = "phylogram",
19
+\S4method{plot}{codeml,ANY}(x, layout = "rectangular",
20 20
   branch.length = "mlc.branch.length", show.tip.label = TRUE,
21 21
   tip.label.size = 4, tip.label.hjust = -0.1, position = "branch",
22 22
   annotation = "dN_vs_dS", annotation.size = 3,
23 23
   annotation.color = "black", ndigits = 2, ...)
24 24
 
25
-\S4method{plot}{codeml_mlc,ANY}(x, layout = "phylogram",
25
+\S4method{plot}{codeml_mlc,ANY}(x, layout = "rectangular",
26 26
   branch.length = "branch.length", show.tip.label = TRUE,
27 27
   tip.label.size = 4, tip.label.hjust = -0.1, position = "branch",
28 28
   annotation = "dN_vs_dS", annotation.size = 3,
29 29
   annotation.color = "black", ndigits = 2, ...)
30 30
 
31
-\S4method{plot}{hyphy,ANY}(x, layout = "phylogram", show.tip.label = TRUE,
31
+\S4method{plot}{hyphy,ANY}(x, layout = "rectangular", show.tip.label = TRUE,
32 32
   tip.label.size = 4, tip.label.hjust = -0.1, position = "branch",
33 33
   annotation = "subs", annotation.color = "black", annotation.size = 3,
34 34
   ...)
35 35
 
36
-\S4method{plot}{paml_rst,ANY}(x, layout = "phylogram",
36
+\S4method{plot}{paml_rst,ANY}(x, layout = "rectangular",
37 37
   show.tip.label = TRUE, tip.label.size = 4, tip.label.hjust = -0.1,
38 38
   position = "branch", annotation = "marginal_subs",
39 39
   annotation.color = "black", annotation.size = 3, ...)
... ...
@@ -21,8 +21,7 @@ update tree
21 21
 library("ggplot2")
22 22
 nwk <- system.file("extdata", "sample.nwk", package="ggtree")
23 23
 tree <- read.tree(nwk)
24
-p <- ggtree(tree) + geom_point(subset=.(!isTip),
25
-        	       color="#b5e521", alpha=1/4, size=10)
24
+p <- ggtree(tree) + geom_tippoint(color="#b5e521", alpha=1/4, size=10)
26 25
 p \%<\% rtree(30)
27 26
 }
28 27
 \author{
... ...
@@ -48,15 +48,15 @@ If you use `r Biocpkg("ggtree")` in published research, please cite:
48 48
 ```
49 49
 G Yu, D Smith, H Zhu, Y Guan, TTY Lam,
50 50
 ggtree: an R package for visualization and annotation of phylogenetic tree with different types of meta-data.
51
-Methods in Ecology and Evolution submitted
51
+submitted.
52 52
 ```
53 53
 
54 54
 # Introduction
55
-This project arose from my needs to annotate nucleotide substitutions in the phylogenetic tree, and I found that there is no tree visualization software can do this easily. Existing tree viewers are designed for displaying phylogenetic tree, but not annotating it. Although some tree viewers can displaying bootstrap values in the tree, it is hard/impossible to display other information in the tree. My first solution for displaying nucleotide substituitions in the tree is to add this information in the node/tip names and use traditional tree viewer to show it. I displayed the information in the tree successfully, but I believe this indirect approach is inefficient.
55
+This project arose from our needs to annotate nucleotide substitutions in the phylogenetic tree, and we found that there is no tree visualization software can do this easily. Existing tree viewers are designed for displaying phylogenetic tree, but not annotating it. Although some tree viewers can displaying bootstrap values in the tree, it is hard/impossible to display other information in the tree. Our first solution for displaying nucleotide substituitions in the tree is to add this information in the node/tip names and use traditional tree viewer to show it. We displayed the information in the tree successfully, but We believe this indirect approach is inefficient.
56 56
 
57
-In the old day, phylogenetic tree is often small. At that time, as we almost didn't have a need to annotate a tree; displaying the evolution relationships is mostly enough. Nowadays, we can obtain a lot of data from different experiments, and we want to associate our data, for instance antigenic change, with the evolution relationship. Visualizing these associations in the phylogenetic tree can help us to identify evolution patterns. I believe we need a next generation tree viewer that can view a phylogenetic tree easily as we did with classical software and support adding annotation data in a layer above the tree. This is the objective of developing the `r Githubpkg("GuangchuangYu/ggtree")`. Common tasks of annotating a phylogenetic tree should be easy and complicated tasks can be possible to achieve by adding multiple layers of annotation.
57
+In the old day, phylogenetic tree is often small. At that time, as we almost didn't have a need to annotate a tree; displaying the evolution relationships is mostly enough. Nowadays, we can obtain a lot of data from different experiments, and we want to associate our data, for instance antigenic change, with the evolution relationship. Visualizing these associations in the phylogenetic tree can help us to identify evolution patterns. We believe we need a next generation tree viewer that should be programmable and extensible. It can view a phylogenetic tree easily as we did with classical software and support adding annotation data in a layer above the tree. This is the objective of developing the `r Githubpkg("GuangchuangYu/ggtree")`. Common tasks of annotating a phylogenetic tree should be easy and complicated tasks can be possible to achieve by adding multiple layers of annotation.
58 58
 
59
-The `r Githubpkg("GuangchuangYu/ggtree")` is designed by extending the `r CRANpkg("ggplot2")`[@wickham_ggplot2_2009] package. It is based on the grammar of graphics and takes all the good parts of `r CRANpkg("ggplot2")`. There are other R packages that implement tree viewer using `r CRANpkg("ggplot2")`, including `r CRANpkg("OutbreakTools")`, `r Biocpkg("phyloseq")`[@mcmurdie_phyloseq_2013] and `r Githubpkg("gjuggler/ggphylo")`; they mostly create complex tree view functions for their specific needs. The `r Githubpkg("GuangchuangYu/ggtree")` is different to them by allowing general flexibilities of annotating phylogenetic tree with diverse types of user inputs. 
59
+The `r Githubpkg("GuangchuangYu/ggtree")` is designed by extending the `r CRANpkg("ggplot2")`[@wickham_ggplot2_2009] package. It is based on the grammar of graphics and takes all the good parts of `r CRANpkg("ggplot2")`. There are other R packages that implement tree viewer using `r CRANpkg("ggplot2")`, including `r CRANpkg("OutbreakTools")`, `r Biocpkg("phyloseq")`[@mcmurdie_phyloseq_2013] and `r Githubpkg("gjuggler/ggphylo")`; they mostly create complex tree view functions for their specific needs. Internally, these packages interpret a phylogenetic as a collection of `lines`, which makes it hard to annotate diverse user input that are related to node (taxa). The `r Githubpkg("GuangchuangYu/ggtree")` is different to them by interpreting a tree as a collection of `taxa` and allowing general flexibilities of annotating phylogenetic tree with diverse types of user inputs. 
60 60
 
61 61
 # Tree visualization
62 62
 ## viewing tree with `ggtree`
... ...
@@ -85,7 +85,7 @@ By default, the tree is viewing in ladderize form, user can set the parameter _`
85 85
 ggtree(tree, ladderize=FALSE)
86 86
 ```
87 87
 
88
-The _`branch.length`_ is used to scale the edge, user can set the parameter _`branch.length = "none"`_ to only viewing the tree topology.
88
+The _`branch.length`_ is used to scale the edge, user can set the parameter _`branch.length = "none"`_ to only viewing the tree topology (cladogram) or other numerical variable to scale the tree (e.g. dN/dS).
89 89
 
90 90
 ```{r fig.width=3, fig.height=3, fig.align="center"}
91 91
 ggtree(tree, branch.length="none")
... ...
@@ -111,22 +111,24 @@ User can use _`ggtree(object)`_ command to view the phylogenetic tree directly,
111 111
 
112 112
 Currently, _`ggtree`_ supports several layout, including:
113 113
 
114
- + `phylogram` (by default)
115
- + `cladogram`
116
- + `dendrogram` 
117
- + `fan`
118
- + `unrooted`. 
114
++ `rectangular` (by default)
115
++ `slanted`
116
++ `fan` or `circular`
117
+
118
+for `Phylogram` (by default) and `Cladogram` if user explicitly setting `branch.length='none'`.
119
+
120
+And `unrooted` layout. 
119 121
 
120 122
 Unrooted layout was implemented by the _`equal-angle algorithm`_ that described in _Inferring Phylogenies_[@felsenstein_inferring_2003 pp.578-580].
121 123
 
122 124
 ```{r fig.width=6, fig.height=9, fig.align="center"}
123 125
 library("gridExtra")
124
-grid.arrange(ggtree(tree) + ggtitle("phylogram layout"),
125
-	     ggtree(tree, layout="dendrogram") + ggtitle("dendrogram layout"),
126
-	     ggtree(tree, layout="cladogram") + ggtitle("cladogram layout"),
127
-	     ggtree(tree, layout="cladogram", branch.length="none") + 
128
-                 scale_x_reverse()+coord_flip() + ggtitle("cladogram layout"),
129
-	     ggtree(tree, layout="fan") + ggtitle("fan layout"),
126
+grid.arrange(ggtree(tree) + ggtitle("(Phylogram) rectangular layout"),
127
+             ggtree(tree, branch.length='none') + ggtitle("(Cladogram) rectangular layout"),
128
+	     ggtree(tree, layout="slanted") + ggtitle("(Phylogram) slanted layout"),
129
+             ggtree(tree, layout="slanted", branch.length='none') + ggtitle("(Cladogram) slanted layout"),
130
+	     ggtree(tree, layout="circular") + ggtitle("(Phylogram) circular layout"),
131
+             ggtree(tree, layout="circular", branch.length="none") + ggtitle("(Cladogram) circular layout"),
130 132
 	     ggtree(tree, layout="unrooted") + ggtitle("unrooted layout"),
131 133
 	     ncol=2)
132 134
 ```	
... ...
@@ -165,17 +167,15 @@ ggtree(tree) + theme_tree2()
165 167
 
166 168
 ## display nodes/tips
167 169
 
168
-Show all the internal nodes and tips in the tree can be done by adding a layer of points using _`geom_point`_.
170
+Show all the internal nodes and tips in the tree can be done by adding a layer of points using _`geom_nodepoint`_,  _`geom_tippoint`_ or _`geom_point`_.
169 171
 
170 172
 ```{r fig.width=3, fig.height=3, fig.align="center"}
171 173
 ggtree(tree)+geom_point(aes(shape=isTip, color=isTip), size=3)
172 174
 ```
173 175
  
174
-And of course, we can separate nodes and tips by using _`subset`_.
175 176
 ```{r fig.width=3, fig.height=3, fig.align="center"}
176
-p <- ggtree(tree) + geom_point(subset=.(!isTip), 
177
-     		       	       color="#b5e521", alpha=1/4, size=10)
178
-p + geom_point(color="#FDAC4F", shape=8, size=3, subset=.(isTip))
177
+p <- ggtree(tree) + geom_nodepoint(color="#b5e521", alpha=1/4, size=10)
178
+p + geom_tippoint(color="#FDAC4F", shape=8, size=3)
179 179
 ```
180 180
 
181 181
 ## display labels
... ...
@@ -186,9 +186,9 @@ Users can use _`geom_text`_ to display the node/tip labels:
186 186
 p + geom_text(aes(label=label), size=3, color="purple", hjust=-0.3)
187 187
 ```
188 188
 
189
-For _`fan`_ and _`unrooted`_ layout, `r Githubpkg("GuangchuangYu/ggtree")` supports rotating node labels according to the angles of the branches.
189
+For _`circular`_ and _`unrooted`_ layout, `r Githubpkg("GuangchuangYu/ggtree")` supports rotating node labels according to the angles of the branches.
190 190
 ```{r fig.width=6, fig.height=6, warning=FALSE, fig.align="center"}
191
-ggtree(tree, layout="fan") + geom_text(aes(label=label, angle=angle), size=3, color="purple", vjust=-0.3)
191
+ggtree(tree, layout="circular") + geom_text(aes(label=label, angle=angle), size=3, color="purple", vjust=-0.3)
192 192
 ```
193 193
 
194 194
 
... ...
@@ -211,7 +211,7 @@ grid.arrange(
211 211
 ```
212 212
 
213 213
 ## update tree viewing with a new tree
214
-In the [display nodes/tips](#display-nodestips) section, we have a _`p`_ object that stored the tree viewing of 13 tips and internal nodes highlighted with specific colored big dots. If you want to applied this pattern (we can imaging a more complex one) to a new tree, we don't need to build the tree step by step. `r Githubpkg("GuangchuangYu/ggtree")` provides an operator, _`%<%`_, for applying the visualization pattern to a new tree.