Browse code

remove layout.method parameter

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

Guangchuang Yu authored on 20/04/2017 02:31:31
Showing 10 changed files

... ...
@@ -2,7 +2,7 @@ Package: ggtree
2 2
 Type: Package
3 3
 Title: an R package for visualization and annotation of phylogenetic trees with
4 4
     their covariates and other associated data
5
-Version: 1.7.10
5
+Version: 1.7.11
6 6
 Authors@R: c(
7 7
 	   person("Guangchuang", "Yu", email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph")),
8 8
 	   person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com", rol = c("aut", "ths")),
... ...
@@ -1,3 +1,9 @@
1
+CHANGES IN VERSION 1.7.11
2
+------------------------
3
+ o remove layout.method parameter <2017-04-20, Thu>
4
+   + https://github.com/GuangchuangYu/ggtree/issues/118#issuecomment-295130818
5
+   + https://github.com/GuangchuangYu/ggtree/issues/125
6
+
1 7
 CHANGES IN VERSION 1.7.10
2 8
 ------------------------
3 9
  o add message for subview, inset, phylopic, theme_transparent and theme_inset <2017-03-23, Thu>
... ...
@@ -4,7 +4,7 @@
4 4
 ##' @title geom_tree
5 5
 ##' @param mapping aesthetic mapping
6 6
 ##' @param data data
7
-##' @param layout one of 'rectangular', 'slanted', 'circular', 'radial' or 'unrooted'
7
+##' @param layout one of 'rectangular', 'slanted', 'circular', 'radial', 'equal_angle' or 'daylight'
8 8
 ##' @param multiPhylo logical
9 9
 ##' @param ... additional parameter
10 10
 ##' @return tree layer
... ...
@@ -61,7 +61,7 @@ stat_tree <- function(mapping=NULL, data=NULL, geom="segment", position="identit
61 61
                    check.aes = FALSE
62 62
                    )
63 63
              )
64
-    } else if (layout %in% c("slanted", "radial", "unrooted")) {
64
+    } else if (layout %in% c("slanted", "radial", "equal_angle", "daylight")) {
65 65
         layer(stat=StatTree,
66 66
               data=data,
67 67
               mapping=mapping,
... ...
@@ -4,8 +4,7 @@
4 4
 ##' @title ggtree
5 5
 ##' @param tr phylo object
6 6
 ##' @param mapping aes mapping
7
-##' @param layout one of 'rectangular', 'slanted', 'fan', 'circular', 'radial' or 'unrooted'
8
-##' @param layout.method of 'equal_angle', 'daylight'.
7
+##' @param layout one of 'rectangular', 'slanted', 'fan', 'circular', 'radial', 'equal_angle' or 'daylight'
9 8
 ##' @param open.angle open angle, only for 'fan' layout
10 9
 ##' @param mrsd most recent sampling date
11 10
 ##' @param as.Date logical whether using Date class in time tree
... ...
@@ -34,7 +33,6 @@
34 33
 ggtree <- function(tr,
35 34
                    mapping        = NULL,
36 35
                    layout         = "rectangular",
37
-                   layout.method  = "equal_angle",
38 36
                    open.angle     = 0,
39 37
                    mrsd           = NULL,
40 38
                    as.Date        = FALSE,
... ...
@@ -47,9 +45,12 @@ ggtree <- function(tr,
47 45
                    ...) {
48 46
 
49 47
     # Check if layout string is valid.
50
-    layout %<>% match.arg(c("rectangular", "slanted", "fan", "circular", "radial", "unrooted"))
51
-    layout.method %<>% match.arg(c("equal_angle", "daylight"))
52
-  
48
+    layout %<>% match.arg(c("rectangular", "slanted", "fan", "circular", "radial", "unrooted", "equal_angle", "daylight"))
49
+    if (layout == "unrooted") {
50
+        layout <- "daylight"
51
+        message('"daylight" method was used as default layout for unrooted tree.')
52
+    }
53
+
53 54
     if (is(tr, "r8s") && branch.length == "branch.length") {
54 55
         branch.length = "TREE"
55 56
     }
... ...
@@ -64,11 +65,10 @@ ggtree <- function(tr,
64 65
     } else {
65 66
         mapping <- modifyList(aes_(~x, ~y), mapping)
66 67
     }
67
-  
68
-    p <- ggplot(tr, 
68
+
69
+    p <- ggplot(tr,
69 70
                 mapping       = mapping,
70 71
                 layout        = layout,
71
-                layout.method = layout.method,
72 72
                 mrsd          = mrsd,
73 73
                 as.Date       = as.Date,
74 74
                 yscale        = yscale,
... ...
@@ -110,7 +110,6 @@ rm.singleton.newick <- function(nwk, outfile = NULL) {
110 110
 ##' @export
111 111
 fortify.beast <- function(model, data,
112 112
                           layout        = "rectangular",
113
-                          layout.method = "equal_angle",
114 113
                           yscale        = "none",
115 114
                           ladderize     = TRUE,
116 115
                           right         = FALSE,
... ...
@@ -120,9 +119,12 @@ fortify.beast <- function(model, data,
120 119
 
121 120
     model <- set_branch_length(model, branch.length)
122 121
     phylo <- model@phylo
123
-    df    <- fortify(phylo, layout=layout, layout.method=layout.method,
124
-                     branch.length=branch.length,
125
-                     ladderize=ladderize, right=right, mrsd = mrsd, ...)
122
+    df    <- fortify(phylo,
123
+                     layout = layout,
124
+                     branch.length = branch.length,
125
+                     ladderize = ladderize,
126
+                     right = right,
127
+                     mrsd = mrsd, ...)
126 128
 
127 129
     stats <- model@stats
128 130
 
... ...
@@ -222,7 +224,6 @@ fortify.beast <- function(model, data,
222 224
 ##' @export
223 225
 fortify.codeml <- function(model, data,
224 226
                            layout        = "rectangular",
225
-                           layout.method = "equal_angle",
226 227
                            yscale        = "none",
227 228
                            ladderize     = TRUE,
228 229
                            right         = FALSE,
... ...
@@ -268,7 +269,6 @@ fortify.codeml <- function(model, data,
268 269
 ##' @export
269 270
 fortify.codeml_mlc <- function(model, data,
270 271
                                layout        = "rectangular",
271
-                               layout.method = "equal_angle",
272 272
                                yscale        = "none",
273 273
                                ladderize     = TRUE,
274 274
                                right         = FALSE,
... ...
@@ -310,7 +310,6 @@ merge_phylo_anno.codeml_mlc <- function(df, dNdS, ndigits = NULL) {
310 310
 
311 311
 fortify.codeml_mlc_ <- function(model, data,
312 312
                                 layout        = "rectangular",
313
-                                layout.method = "equal_angle",
314 313
                                 ladderize     = TRUE,
315 314
                                 right         = FALSE,
316 315
                                 branch.length = "branch.length",
... ...
@@ -322,12 +321,13 @@ fortify.codeml_mlc_ <- function(model, data,
322 321
 
323 322
 ##' @method fortify paml_rst
324 323
 ##' @export
325
-fortify.paml_rst <- function(model, data, 
326
-                             layout = "rectangular", 
327
-                             yscale="none",
328
-                             ladderize=TRUE, 
329
-                             right=FALSE, 
330
-                             mrsd=NULL, ...) {
324
+fortify.paml_rst <- function(model, data,
325
+                             layout    = "rectangular",
326
+                             yscale    = "none",
327
+                             ladderize = TRUE,
328
+                             right     = FALSE,
329
+                             mrsd      = NULL,
330
+                             ...) {
331 331
     df <- fortify.phylo(model@phylo, data, layout, ladderize, right, mrsd=mrsd, ...)
332 332
     df <- merge_phylo_anno.paml_rst(df, model)
333 333
     df <- scaleY(model@phylo, df, yscale, layout, ...)
... ...
@@ -362,11 +362,12 @@ fortify.hyphy <- fortify.paml_rst
362 362
 ##' @importFrom treeio get.placements
363 363
 ##' @export
364 364
 fortify.jplace <- function(model, data,
365
-                           layout="rectangular",
366
-                           yscale="none",
367
-                           ladderize=TRUE, 
368
-                           right=FALSE, 
369
-                           mrsd=NULL, ...) {
365
+                           layout    = "rectangular",
366
+                           yscale    = "none",
367
+                           ladderize = TRUE,
368
+                           right     = FALSE,
369
+                           mrsd      = NULL,
370
+                           ...) {
370 371
     df <- extract.treeinfo.jplace(model, layout, ladderize, right, mrsd=mrsd, ...)
371 372
     place <- get.placements(model, by="best")
372 373
 
... ...
@@ -405,8 +406,13 @@ scaleY <- function(phylo, df, yscale, layout, ...) {
405 406
 ##' @method fortify phylo4
406 407
 ##' @importFrom treeio as.phylo
407 408
 ##' @export
408
-fortify.phylo4 <- function(model, data, layout="rectangular", yscale="none",
409
-                           ladderize=TRUE, right=FALSE, mrsd=NULL, ...) {
409
+fortify.phylo4 <- function(model, data,
410
+                           layout    = "rectangular",
411
+                           yscale    = "none",
412
+                           ladderize = TRUE,
413
+                           right     = FALSE,
414
+                           mrsd      = NULL,
415
+                           ...) {
410 416
     phylo <- as.phylo(model)
411 417
     df <- fortify.phylo(phylo, data,
412 418
                         layout, ladderize, right, mrsd=mrsd, ...)
... ...
@@ -415,14 +421,14 @@ fortify.phylo4 <- function(model, data, layout="rectangular", yscale="none",
415 421
 
416 422
 ##' @method fortify phylo4d
417 423
 ##' @export
418
-fortify.phylo4d <- function(model, data, 
419
-                            layout="rectangular",
420
-                            layout.method = "equal_angle",
421
-                            yscale="none",
422
-                            ladderize=TRUE, 
423
-                            right=FALSE, 
424
-                            branch.length="branch.length",
425
-                            mrsd=NULL, ...) {
424
+fortify.phylo4d <- function(model, data,
425
+                            layout        = "rectangular",
426
+                            yscale        = "none",
427
+                            ladderize     = TRUE,
428
+                            right         = FALSE,
429
+                            branch.length = "branch.length",
430
+                            mrsd          = NULL,
431
+                            ...) {
426 432
     ## model <- set_branch_length(model, branch.length)
427 433
     ## phylo <- as.phylo.phylo4(model)
428 434
     ## res <- fortify(phylo, data, layout, branch.length=branch.length,
... ...
@@ -430,7 +436,7 @@ fortify.phylo4d <- function(model, data,
430 436
     ## tdata <- model@data[match(res$node, rownames(model@data)), , drop=FALSE]
431 437
     ## df <- cbind(res, tdata)
432 438
     ## scaleY(as.phylo.phylo4(model), df, yscale, layout, ...)
433
-    fortify(as.treedata(model), data, layout, layout.method, yscale, ladderize, right, branch.length, mrsd, ...)
439
+    fortify(as.treedata(model), data, layout, yscale, ladderize, right, branch.length, mrsd, ...)
434 440
 }
435 441
 
436 442
 
... ...
@@ -455,12 +461,12 @@ fortify.phylo4d <- function(model, data,
455 461
 ##' @method fortify phylo
456 462
 ##' @export
457 463
 ##' @author Yu Guangchuang
458
-fortify.phylo <- function(model, data, 
459
-                          layout="rectangular",
460
-                          ladderize=TRUE, 
461
-                          right=FALSE, 
462
-                          mrsd=NULL, 
463
-                          as.Date=FALSE, ...) {
464
+fortify.phylo <- function(model, data,
465
+                          layout    = "rectangular",
466
+                          ladderize = TRUE,
467
+                          right     = FALSE,
468
+                          mrsd      = NULL,
469
+                          as.Date   = FALSE, ...) {
464 470
     tree <- reorder.phylo(model, 'postorder')
465 471
 
466 472
     if (ladderize == TRUE) {
... ...
@@ -516,8 +522,8 @@ fortify.phylo <- function(model, data,
516 522
 ##' @author Yu Guangchuang
517 523
 as.data.frame.phylo <- function(x, row.names, optional,
518 524
                                 layout="rectangular", ...) {
519
-    if (layout == "unrooted") {
520
-        return(layout.unrooted(x, ...))
525
+    if (layout %in% c("equal_angle", "daylight")) {
526
+        return(layout.unrooted(x, layout.method = layout, ...))
521 527
     }
522 528
     as.data.frame.phylo_(x, layout, ...)
523 529
 }
... ...
@@ -605,8 +611,11 @@ as.data.frame.phylo_ <- function(x, layout="rectangular",
605 611
 
606 612
 ##' @method fortify multiPhylo
607 613
 ##' @export
608
-fortify.multiPhylo <-  function(model, data, layout="rectangular",
609
-                                ladderize=TRUE, right=FALSE, mrsd=NULL, ...) {
614
+fortify.multiPhylo <-  function(model, data,
615
+                                layout    = "rectangular",
616
+                                ladderize = TRUE,
617
+                                right     = FALSE,
618
+                                mrsd      = NULL, ...) {
610 619
 
611 620
     df.list <- lapply(model, function(x) fortify(x, layout=layout, ladderize=ladderize, right=right, mrsd=mrsd, ...))
612 621
     if (is.null(names(model))) {
... ...
@@ -626,26 +635,24 @@ fortify.multiPhylo <-  function(model, data, layout="rectangular",
626 635
 
627 636
 ##' @method fortify phylip
628 637
 ##' @export
629
-fortify.phylip <- function(model, data, 
630
-                           layout="rectangular",
631
-                           layout.method = "equal_angle",
632
-                           ladderize=TRUE, 
633
-                           right=FALSE,
634
-                           branch.length = "TREE", 
635
-                           mrsd=NULL, ...) {
638
+fortify.phylip <- function(model, data,
639
+                           layout        = "rectangular",
640
+                           ladderize     = TRUE,
641
+                           right         = FALSE,
642
+                           branch.length = "TREE",
643
+                           mrsd          = NULL, ...) {
636 644
     trees <- get.tree(model)
637 645
     fortify(trees, layout=layout, ladderize = ladderize, right=right, mrsd=mrsd, ...)
638 646
 }
639 647
 
640 648
 ##' @method fortify r8s
641 649
 ##' @export
642
-fortify.r8s <- function(model, data, 
643
-                        layout="rectangular",
644
-                        layout.method = "equal_angle",
645
-                        ladderize=TRUE, 
646
-                        right=FALSE,
647
-                        branch.length = "TREE", 
648
-                        mrsd=NULL, ...) {
650
+fortify.r8s <- function(model, data,
651
+                        layout        = "rectangular",
652
+                        ladderize     = TRUE,
653
+                        right         = FALSE,
654
+                        branch.length = "TREE",
655
+                        mrsd          = NULL, ...) {
649 656
     trees <- get.tree(model)
650 657
     branch.length %<>% match.arg(names(trees))
651 658
     phylo <- trees[[branch.length]]
... ...
@@ -654,11 +661,11 @@ fortify.r8s <- function(model, data,
654 661
 
655 662
 ##' @method fortify obkData
656 663
 ##' @export
657
-fortify.obkData <- function(model, data, 
658
-                            layout="rectangular",
659
-                            ladderize=TRUE, 
660
-                            right=FALSE, 
661
-                            mrsd = NULL, ...) {
664
+fortify.obkData <- function(model, data,
665
+                            layout    = "rectangular",
666
+                            ladderize = TRUE,
667
+                            right     = FALSE,
668
+                            mrsd      = NULL, ...) {
662 669
 
663 670
     df <- fortify(model@trees[[1]], layout=layout, ladderize=ladderize, right=right, mrsd=mrsd, ...)
664 671
 
... ...
@@ -676,11 +683,11 @@ fortify.obkData <- function(model, data,
676 683
 
677 684
 ##' @method fortify phyloseq
678 685
 ##' @export
679
-fortify.phyloseq <- function(model, data, 
680
-                             layout="rectangular",
681
-                             ladderize=TRUE, 
682
-                             right=FALSE, 
683
-                             mrsd=NULL, ...) {
686
+fortify.phyloseq <- function(model, data,
687
+                             layout    = "rectangular",
688
+                             ladderize = TRUE,
689
+                             right     = FALSE,
690
+                             mrsd      = NULL, ...) {
684 691
 
685 692
     df <- fortify(model@phy_tree, layout=layout, ladderize=ladderize, right=right, mrsd=mrsd, ...)
686 693
     phyloseq <- "phyloseq"
... ...
@@ -180,80 +180,80 @@ layout.unrooted <- function(tree, branch.length="branch.length", layout.method="
180 180
 ##' @param branch.length set to 'none' for edge length of 1. Otherwise the phylogenetic tree edge length is used.
181 181
 ##' @return tree as data.frame with equal angle layout.
182 182
 layoutEqualAngle <- function(tree, branch.length ){
183
-  root <- getRoot(tree)
184
-  # Convert Phylo tree to data.frame.
185
-  df <- as.data.frame.phylo_(tree)
186
-
187
-  # NOTE: Angles (start, end, angle) are in half-rotation units (radians/pi or degrees/180)
188
-
189
-  # create and assign NA to the following fields.
190
-  df$x <- NA
191
-  df$y <- NA
192
-  df$start <- NA # Start angle of segment of subtree.
193
-  df$end   <- NA # End angle of segment of subtree
194
-  df$angle <- NA # Orthogonal angle to beta ... for labels??
195
-  # Initialize root node position and angles.
196
-  df[root, "x"] <- 0
197
-  df[root, "y"] <- 0
198
-  df[root, "start"] <- 0 # 0-degrees
199
-  df[root, "end"]   <- 2 # 360-degrees
200
-  df[root, "angle"] <- 0 # Angle label.
201
-
202
-  N <- getNodeNum(tree)
203
-
204
-  # Get number of tips for each node in tree.
205
-  nb.sp <- sapply(1:N, function(i) length(get.offspring.tip(tree, i)))
206
-  # Get list of node id's.
207
-  nodes <- getNodes_by_postorder(tree)
208
-
209
-  for(curNode in nodes) {
210
-    # Get number of tips for current node.
211
-    curNtip <- nb.sp[curNode]
212
-    # Get array of child node indexes of current node.
213
-    children <- getChild(tree, curNode)
214
-
215
-    # Get "start" and "end" angles of a segment for current node in the data.frame.
216
-    start <- df[curNode, "start"]
217
-    end <- df[curNode, "end"]
183
+    root <- getRoot(tree)
184
+    ## Convert Phylo tree to data.frame.
185
+    df <- as.data.frame.phylo_(tree)
186
+
187
+    ## NOTE: Angles (start, end, angle) are in half-rotation units (radians/pi or degrees/180)
188
+
189
+    ## create and assign NA to the following fields.
190
+    df$x <- NA
191
+    df$y <- NA
192
+    df$start <- NA # Start angle of segment of subtree.
193
+    df$end   <- NA # End angle of segment of subtree
194
+    df$angle <- NA # Orthogonal angle to beta ... for labels??
195
+    ## Initialize root node position and angles.
196
+    df[root, "x"] <- 0
197
+    df[root, "y"] <- 0
198
+    df[root, "start"] <- 0 # 0-degrees
199
+    df[root, "end"]   <- 2 # 360-degrees
200
+    df[root, "angle"] <- 0 # Angle label.
201
+
202
+    N <- getNodeNum(tree)
203
+
204
+    ## Get number of tips for each node in tree.
205
+    nb.sp <- sapply(1:N, function(i) length(get.offspring.tip(tree, i)))
206
+    ## Get list of node id's.
207
+    nodes <- getNodes_by_postorder(tree)
208
+
209
+    for(curNode in nodes) {
210
+        ## Get number of tips for current node.
211
+        curNtip <- nb.sp[curNode]
212
+        ## Get array of child node indexes of current node.
213
+        children <- getChild(tree, curNode)
214
+
215
+        ## Get "start" and "end" angles of a segment for current node in the data.frame.
216
+        start <- df[curNode, "start"]
217
+        end <- df[curNode, "end"]
218
+
219
+        if (length(children) == 0) {
220
+            ## is a tip
221
+            next
222
+        }
218 223
 
219
-    if (length(children) == 0) {
220
-      ## is a tip
221
-      next
222
-    }
224
+        for (i in seq_along(children)) {
225
+            child <- children[i]
226
+            ## Get the number of tips for child node.
227
+            ntip.child <- nb.sp[child]
228
+
229
+            ## Calculated in half radians.
230
+            ## alpha: angle of segment for i-th child with ntips_ij tips.
231
+            ## alpha = (left_angle - right_angle) * (ntips_ij)/(ntips_current)
232
+            alpha <- (end - start) * ntip.child / curNtip
233
+            ## beta = angle of line from parent node to i-th child.
234
+            beta <- start + alpha / 2
235
+
236
+            if (branch.length == "none") {
237
+                length.child <- 1
238
+            } else {
239
+                length.child <- df[child, "length"]
240
+            }
223 241
 
224
-    for (i in seq_along(children)) {
225
-      child <- children[i]
226
-      # Get the number of tips for child node.
227
-      ntip.child <- nb.sp[child]
228
-
229
-      # Calculated in half radians.
230
-      # alpha: angle of segment for i-th child with ntips_ij tips.
231
-      # alpha = (left_angle - right_angle) * (ntips_ij)/(ntips_current)
232
-      alpha <- (end - start) * ntip.child / curNtip
233
-      # beta = angle of line from parent node to i-th child.
234
-      beta <- start + alpha / 2
235
-
236
-      if (branch.length == "none") {
237
-        length.child <- 1
238
-      } else {
239
-        length.child <- df[child, "length"]
240
-      }
242
+            ## update geometry of data.frame.
243
+            ## Calculate (x,y) position of the i-th child node from current node.
244
+            df[child, "x"] <- df[curNode, "x"] + cospi(beta) * length.child
245
+            df[child, "y"] <- df[curNode, "y"] + sinpi(beta) * length.child
246
+            ## Calculate orthogonal angle to beta.
247
+            df[child, "angle"] <- -90 - 180 * beta * sign(beta - 1)
248
+            ## Update the start and end angles of the childs segment.
249
+            df[child, "start"] <- start
250
+            df[child, "end"] <- start + alpha
251
+            start <- start + alpha
252
+        }
241 253
 
242
-      # update geometry of data.frame.
243
-      # Calculate (x,y) position of the i-th child node from current node.
244
-      df[child, "x"] <- df[curNode, "x"] + cospi(beta) * length.child
245
-      df[child, "y"] <- df[curNode, "y"] + sinpi(beta) * length.child
246
-      # Calculate orthogonal angle to beta.
247
-      df[child, "angle"] <- -90 - 180 * beta * sign(beta - 1)
248
-      # Update the start and end angles of the childs segment.
249
-      df[child, "start"] <- start
250
-      df[child, "end"] <- start + alpha
251
-      start <- start + alpha
252 254
     }
253 255
 
254
-  }
255
-
256
-  return(df)
256
+    return(df)
257 257
 
258 258
 }
259 259
 
... ...
@@ -303,7 +303,7 @@ layoutDaylight <- function( tree, branch.length ){
303 303
   i <- 1
304 304
   ave_change <- 1.0
305 305
   while( i <= MAX_COUNT & ave_change > MINIMUM_AVERAGE_ANGLE_CHANGE ){
306
-    cat('Iteration: ', i, '\n')
306
+      ## cat('Iteration: ', i, '\n')
307 307
 
308 308
     # Reset max_change after iterating over tree.
309 309
     total_max <- 0.0
... ...
@@ -320,7 +320,7 @@ layoutDaylight <- function( tree, branch.length ){
320 320
 
321 321
     ave_change <- total_max / length(nodes)
322 322
 
323
-    cat('Average angle change', ave_change,'\n')
323
+    ## cat('Average angle change', ave_change,'\n')
324 324
 
325 325
     i <- i + 1
326 326
   }
... ...
@@ -12,6 +12,7 @@ html_preview: false
12 12
 
13 13
 ```{r echo=FALSE, results="hide", message=FALSE}
14 14
 library("txtplot")
15
+library("badger")
15 16
 library("ypages")
16 17
 ```
17 18
 
... ...
@@ -36,7 +37,6 @@ library("ypages")
36 37
 [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/ggtree.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/ggtree/)
37 38
 [![Linux/Mac Travis Build Status](https://img.shields.io/travis/GuangchuangYu/ggtree/master.svg?label=Mac%20OSX%20%26%20Linux)](https://travis-ci.org/GuangchuangYu/ggtree)
38 39
 [![AppVeyor Build Status](https://img.shields.io/appveyor/ci/Guangchuangyu/ggtree/master.svg?label=Windows)](https://ci.appveyor.com/project/GuangchuangYu/ggtree)
39
-[![install with bioconda](https://img.shields.io/badge/install%20with-bioconda-green.svg?style=flat)](http://bioconda.github.io/recipes/bioconductor-ggtree/README.html)
40 40
 
41 41
 
42 42
 
... ...
@@ -44,6 +44,15 @@ The `ggtree` package extending the `ggplot2` package. It based on grammar of gra
44 44
 
45 45
 [![Twitter](https://img.shields.io/twitter/url/https/github.com/GuangchuangYu/ggtree.svg?style=social)](https://twitter.com/intent/tweet?hashtags=ggtree&url=http://onlinelibrary.wiley.com/doi/10.1111/2041-210X.12628/abstract&screen_name=guangchuangyu)
46 46
 
47
+
48
+For details, please visit our project website, <https://guangchuangyu.github.io/ggtree>.
49
+
50
++ [Documentation](https://guangchuangyu.github.io/ggtree/documentation/)
51
++ [FAQ](https://guangchuangyu.github.io/ggtree/faq/)
52
++ [Featured Articles](https://guangchuangyu.github.io/ggtree/featuredArticles/)
53
++ [Feedback](https://guangchuangyu.github.io/ggtree/#feedback)
54
+
55
+
47 56
 -----------------------------------------------------
48 57
 
49 58
 Please cite the following article when using `ggtree`:
... ...
@@ -52,21 +61,15 @@ __G Yu__, DK Smith, H Zhu, Y Guan, TTY Lam^\*^. ggtree: an R package for visuali
52 61
 
53 62
 
54 63
 `r badge_doi("10.1111/2041-210X.12628", "green")`
55
-`r badge_citation("HtEfBTGE9r8C", "7268358477862164627", "green")`
56 64
 `r badge_altmetric("10533079", "green")`
57 65
 
58 66
 ----------------------------------------------------------------------------------------
59 67
 
60
-For details, please visit our project website, <https://guangchuangyu.github.io/ggtree>.
61
-
62
-+ [Documentation](https://guangchuangyu.github.io/ggtree/documentation/)
63
-+ [FAQ](https://guangchuangyu.github.io/ggtree/faq/)
64
-+ [Featured Articles](https://guangchuangyu.github.io/ggtree/featuredArticles/)
65
-+ [Feedback](https://guangchuangyu.github.io/ggtree/#feedback)
66 68
 
67 69
 ### Citation
68 70
 
69 71
 `r badge_citation("HtEfBTGE9r8C", "7268358477862164627", "green")`
72
+`r badge_sci_citation("http://apps.webofknowledge.com/InboundService.do?mode=FullRecord&customersID=RID&IsProductCode=Yes&product=WOS&Init=Yes&Func=Frame&DestFail=http%3A%2F%2Fwww.webofknowledge.com&action=retrieve&SrcApp=RID&SrcAuth=RID&SID=U2EMQLA1958R5PUSAKt&UT=WOS%3A000393305300004", "green")`
70 73
 
71 74
 
72 75
 ```{r echo=F, comment=NA}
... ...
@@ -4,56 +4,56 @@ ggtree: an R package for visualization and annotation of phylogenetic trees with
4 4
 
5 5
 <img src="https://raw.githubusercontent.com/Bioconductor/BiocStickers/master/ggtree/ggtree.png" height="200" align="right" />
6 6
 
7
-[![](https://img.shields.io/badge/release%20version-1.6.11-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![](https://img.shields.io/badge/devel%20version-1.7.10-green.svg?style=flat)](https://github.com/guangchuangyu/ggtree) [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since) [![](https://img.shields.io/badge/download-13972/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-1385/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
7
+[![](https://img.shields.io/badge/release%20version-1.6.11-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![](https://img.shields.io/badge/devel%20version-1.7.10-green.svg?style=flat)](https://github.com/guangchuangyu/ggtree) [![Bioc](http://www.bioconductor.org/shields/years-in-bioc/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since) [![](https://img.shields.io/badge/download-14336/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-1385/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
8 8
 
9
-[![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![codecov](https://codecov.io/gh/GuangchuangYu/ggtree/branch/master/graph/badge.svg)](https://codecov.io/gh/GuangchuangYu/ggtree) [![Last-changedate](https://img.shields.io/badge/last%20change-2017--04--11-green.svg)](https://github.com/GuangchuangYu/ggtree/commits/master) [![GitHub forks](https://img.shields.io/github/forks/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/network) [![GitHub stars](https://img.shields.io/github/stars/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/stargazers) [![Awesome](https://cdn.rawgit.com/sindresorhus/awesome/d7305f38d29fed78fa85652e3a63e154dd8e8829/media/badge.svg)](https://awesome-r.com/#awesome-r-graphic-displays)
9
+[![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![codecov](https://codecov.io/gh/GuangchuangYu/ggtree/branch/master/graph/badge.svg)](https://codecov.io/gh/GuangchuangYu/ggtree) [![Last-changedate](https://img.shields.io/badge/last%20change-2017--04--20-green.svg)](https://github.com/GuangchuangYu/ggtree/commits/master) [![GitHub forks](https://img.shields.io/github/forks/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/network) [![GitHub stars](https://img.shields.io/github/stars/GuangchuangYu/ggtree.svg)](https://github.com/GuangchuangYu/ggtree/stargazers) [![Awesome](https://cdn.rawgit.com/sindresorhus/awesome/d7305f38d29fed78fa85652e3a63e154dd8e8829/media/badge.svg)](https://awesome-r.com/#awesome-r-graphic-displays)
10 10
 
11
-[![platform](http://www.bioconductor.org/shields/availability/devel/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#archives) [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/ggtree.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/ggtree/) [![Linux/Mac Travis Build Status](https://img.shields.io/travis/GuangchuangYu/ggtree/master.svg?label=Mac%20OSX%20%26%20Linux)](https://travis-ci.org/GuangchuangYu/ggtree) [![AppVeyor Build Status](https://img.shields.io/appveyor/ci/Guangchuangyu/ggtree/master.svg?label=Windows)](https://ci.appveyor.com/project/GuangchuangYu/ggtree) [![install with bioconda](https://img.shields.io/badge/install%20with-bioconda-green.svg?style=flat)](http://bioconda.github.io/recipes/bioconductor-ggtree/README.html)
11
+[![platform](http://www.bioconductor.org/shields/availability/devel/ggtree.svg)](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#archives) [![Build Status](http://www.bioconductor.org/shields/build/devel/bioc/ggtree.svg)](https://bioconductor.org/checkResults/devel/bioc-LATEST/ggtree/) [![Linux/Mac Travis Build Status](https://img.shields.io/travis/GuangchuangYu/ggtree/master.svg?label=Mac%20OSX%20%26%20Linux)](https://travis-ci.org/GuangchuangYu/ggtree) [![AppVeyor Build Status](https://img.shields.io/appveyor/ci/Guangchuangyu/ggtree/master.svg?label=Windows)](https://ci.appveyor.com/project/GuangchuangYu/ggtree)
12 12
 
13 13
 The `ggtree` package extending the `ggplot2` package. It based on grammar of graphics and takes all the good parts of `ggplot2`. `ggtree` is designed for not only viewing phylogenetic tree but also displaying annotation data on the tree.
14 14
 
15 15
 [![Twitter](https://img.shields.io/twitter/url/https/github.com/GuangchuangYu/ggtree.svg?style=social)](https://twitter.com/intent/tweet?hashtags=ggtree&url=http://onlinelibrary.wiley.com/doi/10.1111/2041-210X.12628/abstract&screen_name=guangchuangyu)
16 16
 
17
+For details, please visit our project website, <https://guangchuangyu.github.io/ggtree>.
18
+
19
+-   [Documentation](https://guangchuangyu.github.io/ggtree/documentation/)
20
+-   [FAQ](https://guangchuangyu.github.io/ggtree/faq/)
21
+-   [Featured Articles](https://guangchuangyu.github.io/ggtree/featuredArticles/)
22
+-   [Feedback](https://guangchuangyu.github.io/ggtree/#feedback)
23
+
17 24
 ------------------------------------------------------------------------
18 25
 
19 26
 Please cite the following article when using `ggtree`:
20 27
 
21 28
 **G Yu**, DK Smith, H Zhu, Y Guan, TTY Lam<sup>\*</sup>. ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data. ***Methods in Ecology and Evolution***. 2017, 8(1):28-36.
22 29
 
23
-[![](https://img.shields.io/badge/doi-10.1111/2041--210X.12628-green.svg?style=flat)](http://dx.doi.org/10.1111/2041-210X.12628) [![citation](https://img.shields.io/badge/cited%20by-14-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627) [![](https://img.shields.io/badge/Altmetric-349-green.svg?style=flat)](https://www.altmetric.com/details/10533079)
30
+[![](https://img.shields.io/badge/doi-10.1111/2041--210X.12628-green.svg?style=flat)](http://dx.doi.org/10.1111/2041-210X.12628) [![](https://img.shields.io/badge/Altmetric-348-green.svg?style=flat)](https://www.altmetric.com/details/10533079)
24 31
 
25 32
 ------------------------------------------------------------------------
26 33
 
27
-For details, please visit our project website, <https://guangchuangyu.github.io/ggtree>.
28
-
29
--   [Documentation](https://guangchuangyu.github.io/ggtree/documentation/)
30
--   [FAQ](https://guangchuangyu.github.io/ggtree/faq/)
31
--   [Featured Articles](https://guangchuangyu.github.io/ggtree/featuredArticles/)
32
--   [Feedback](https://guangchuangyu.github.io/ggtree/#feedback)
33
-
34 34
 ### Citation
35 35
 
36
-[![citation](https://img.shields.io/badge/cited%20by-14-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627)
36
+[![citation](https://img.shields.io/badge/cited%20by-15-green.svg?style=flat)](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627) [![](https://img.shields.io/badge/cited%20in%20Web%20of%20Science%20Core%20Collection-6-green.svg?style=flat)](http://apps.webofknowledge.com/InboundService.do?mode=FullRecord&customersID=RID&IsProductCode=Yes&product=WOS&Init=Yes&Func=Frame&DestFail=http%3A%2F%2Fwww.webofknowledge.com&action=retrieve&SrcApp=RID&SrcAuth=RID&SID=U2EMQLA1958R5PUSAKt&UT=WOS%3A000393305300004)
37 37
 
38 38
        +-+---------+---------+---------+---------+---------+---+
39 39
        |                                                   *   |
40
-    12 +                                                       +
40
+       |                                                       |
41 41
        |                                                       |
42 42
     10 +                                                       +
43 43
        |                                                       |
44
-     8 +                                                       +
45
-     6 +                                                       +
46 44
        |                                                       |
47
-     4 +                                                       +
48 45
        |                                                       |
49
-     2 +                                                       +
46
+       |                                                       |
47
+     5 +                                                       +
48
+       |                                                       |
49
+       |                                                       |
50 50
        | *                                                     |
51 51
        +-+---------+---------+---------+---------+---------+---+
52 52
        2016     2016.2    2016.4    2016.6    2016.8     2017   
53 53
 
54 54
 ### Download stats
55 55
 
56
-[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-13972/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-1385/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
56
+[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-14336/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![](https://img.shields.io/badge/download-1385/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
57 57
 
58 58
          ++-------------------+------------------+-------------------+------------------+--------------+
59 59
     3000 +                                                                                        *    +
... ...
@@ -12,7 +12,7 @@ geom_tree(mapping = NULL, data = NULL, layout = "rectangular",
12 12
 
13 13
 \item{data}{data}
14 14
 
15
-\item{layout}{one of 'rectangular', 'slanted', 'circular', 'radial' or 'unrooted'}
15
+\item{layout}{one of 'rectangular', 'slanted', 'circular', 'radial', 'equal_angle' or 'daylight'}
16 16
 
17 17
 \item{multiPhylo}{logical}
18 18
 
... ...
@@ -8,9 +8,8 @@
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, layout = "rectangular",
12
-  layout.method = "equal_angle", open.angle = 0, mrsd = NULL,
13
-  as.Date = FALSE, yscale = "none", yscale_mapping = NULL,
11
+ggtree(tr, mapping = NULL, layout = "rectangular", open.angle = 0,
12
+  mrsd = NULL, as.Date = FALSE, yscale = "none", yscale_mapping = NULL,
14 13
   ladderize = TRUE, right = FALSE, branch.length = "branch.length",
15 14
   ndigits = NULL, ...)
16 15
 }
... ...
@@ -19,9 +18,7 @@ ggtree(tr, mapping = NULL, layout = "rectangular",
19 18
 
20 19
 \item{mapping}{aes mapping}
21 20
 
22
-\item{layout}{one of 'rectangular', 'slanted', 'fan', 'circular', 'radial' or 'unrooted'}
23
-
24
-\item{layout.method}{of 'equal_angle', 'daylight'.}
21
+\item{layout}{one of 'rectangular', 'slanted', 'fan', 'circular', 'radial', 'equal_angle' or 'daylight'}
25 22
 
26 23
 \item{open.angle}{open angle, only for 'fan' layout}
27 24