Browse code

fixed geom_tiplab(geom="label")

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

Guangchuang Yu authored on 02/03/2017 03:05:18
Showing 13 changed files

... ...
@@ -7,3 +7,4 @@ appveyor.yml
7 7
 docs
8 8
 mkdocs
9 9
 .gitmodules
10
+.github
... ...
@@ -1,7 +1,7 @@
1 1
 Package: ggtree
2 2
 Type: Package
3 3
 Title: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data
4
-Version: 1.7.8
4
+Version: 1.7.9
5 5
 Authors@R: c(
6 6
 	   person("Guangchuang", "Yu", email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph")),
7 7
 	   person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com", rol = c("aut", "ths")),
... ...
@@ -1,5 +1,12 @@
1
+CHANGES IN VERSION 1.7.9
2
+------------------------
3
+ o fixed geom_tiplab(geom='label') <2017-03-02, Thu>
4
+   + https://github.com/GuangchuangYu/ggtree/issues/115
5
+
1 6
 CHANGES IN VERSION 1.7.8
2 7
 ------------------------
8
+ o get_taxa_name now sorted by taxa position and also support whole tree <2017-03-01, Wed>
9
+ o unrooted layout support branch.length="none", fixed #114 <2017-03-01, Wed>
3 10
  o remove apeBootstrap and raxml object support as they were removed from treeio <2017-02-28, Tue>
4 11
 
5 12
 CHANGES IN VERSION 1.7.7
... ...
@@ -1,4 +1,4 @@
1
-##' get taxa name of a selected node
1
+##' get taxa name of a selected node (or tree if node=NULL) sorted by their position in plotting
2 2
 ##'
3 3
 ##'
4 4
 ##' @title get_taxa_name
... ...
@@ -7,16 +7,20 @@
7 7
 ##' @return taxa name vector
8 8
 ##' @export
9 9
 ##' @author Guangchuang Yu
10
-get_taxa_name <- function(tree_view=NULL, node) {
10
+get_taxa_name <- function(tree_view=NULL, node=NULL) {
11 11
     tree_view %<>% get_tree_view
12 12
 
13 13
     df <- tree_view$data
14
-    sp <- get.offspring.df(df, node)
15
-    res <- df[sp, "label"]
16
-    return(res[df[sp, "isTip"]])
17
-}
18
-
14
+    if (!is.null(node)) {
15
+        sp <- get.offspring.df(df, node)
16
+        df <- df[sp, ]
17
+    }
19 18
 
19
+    with(df, {
20
+        i = order(y, decreasing=T)
21
+        label[i][isTip[i]]
22
+    })
23
+}
20 24
 
21 25
 
22 26
 ##' view a clade of tree
... ...
@@ -6,6 +6,7 @@
6 6
 ##' @param data A layer specific dataset -
7 7
 ##'             only needed if you want to override he plot defaults.
8 8
 ##' @param ... other arguments passed on to 'layer'
9
+##' @param position The position adjustment to use for overlapping points on this layer
9 10
 ##' @param family sans by default, can be any supported font
10 11
 ##' @param parse if TRUE, the labels will be passd into expressions
11 12
 ##' @param nudge_x horizontal adjustment
... ...
@@ -25,6 +26,7 @@
25 26
 ##' @author Guangchuang Yu
26 27
 geom_label2 <- function(mapping = NULL, data = NULL,
27 28
                         ...,
29
+                        position = "identity",
28 30
                         family = "sans",
29 31
                         parse = FALSE,
30 32
                         nudge_x = 0,
... ...
@@ -36,8 +38,6 @@ geom_label2 <- function(mapping = NULL, data = NULL,
36 38
                         show.legend = NA,
37 39
                         inherit.aes = TRUE) {
38 40
 
39
-    position = "identity"
40
-
41 41
     if (!missing(nudge_x) || !missing(nudge_y)) {
42 42
         if (!missing(position)) {
43 43
             stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE)
... ...
@@ -5,13 +5,13 @@
5 5
 ##' @param mapping the aesthetic mapping
6 6
 ##' @param data A layer specific dataset -
7 7
 ##'             only needed if you want to override he plot defaults.
8
+##' @param ... other arguments passed on to 'layer'
8 9
 ##' @param position The position adjustment to use for overlapping points on this layer
9 10
 ##' @param family sans by default, can be any supported font
10 11
 ##' @param parse if TRUE, the labels will be passd into expressions
11 12
 ##' @param na.rm logical
12 13
 ##' @param show.legend logical
13 14
 ##' @param inherit.aes logical
14
-##' @param ... other arguments passed on to 'layer'
15 15
 ##' @param nudge_x horizontal adjustment
16 16
 ##' @param nudge_y vertical adjustment
17 17
 ##' @param check_overlap if TRUE, text that overlaps previous text in the same layer will not be plotted
... ...
@@ -24,9 +24,16 @@
24 24
 ##' \link[ggplot2]{geom_text}
25 25
 ##' @author Guangchuang Yu
26 26
 geom_text2 <- function(mapping = NULL, data = NULL,
27
-                       position = "identity", family="sans", parse = FALSE,
28
-                       na.rm=TRUE, show.legend = NA, inherit.aes = TRUE,
29
-                       ..., nudge_x = 0, nudge_y = 0, check_overlap = FALSE) {
27
+                       ...,
28
+                       position = "identity",
29
+                       family="sans",
30
+                       parse = FALSE,
31
+                       na.rm=TRUE,
32
+                       show.legend = NA,
33
+                       inherit.aes = TRUE,
34
+                       nudge_x = 0,
35
+                       nudge_y = 0,
36
+                       check_overlap = FALSE) {
30 37
 
31 38
     if (!missing(nudge_x) || !missing(nudge_y)) {
32 39
         if (!missing(position)) {
... ...
@@ -494,7 +494,7 @@ fortify.phylo <- function(model, data, layout="rectangular",
494 494
 as.data.frame.phylo <- function(x, row.names, optional,
495 495
                                 layout="rectangular", ...) {
496 496
     if (layout == "unrooted") {
497
-        return(layout.unrooted(x))
497
+        return(layout.unrooted(x, ...))
498 498
     }
499 499
     as.data.frame.phylo_(x, layout, ...)
500 500
 }
... ...
@@ -159,7 +159,7 @@ reroot_node_mapping <- function(tree, tree2) {
159 159
 
160 160
 
161 161
 ##' @importFrom ape reorder.phylo
162
-layout.unrooted <- function(tree) {
162
+layout.unrooted <- function(tree, branch.length="branch.length", ...) {
163 163
     N <- getNodeNum(tree)
164 164
     root <- getRoot(tree)
165 165
 
... ...
@@ -198,7 +198,12 @@ layout.unrooted <- function(tree) {
198 198
             alpha <- (end - start) * ntip.child/curNtip
199 199
             beta <- start + alpha / 2
200 200
 
201
-            length.child <- df[child, "length"]
201
+            if (branch.length == "none") {
202
+                length.child <- 1
203
+            } else {
204
+                length.child <- df[child, "length"]
205
+            }
206
+
202 207
             df[child, "x"] <- df[curNode, "x"] + cospi(beta) * length.child
203 208
             df[child, "y"] <- df[curNode, "y"] + sinpi(beta) * length.child
204 209
             df[child, "angle"] <- -90 -180 * beta * sign(beta - 1)
... ...
@@ -1,8 +1,6 @@
1 1
 
2 2
 
3 3
 
4
-
5
-
6 4
 ##' @importFrom ggplot2 last_plot
7 5
 get_tree_view <- function(tree_view) {
8 6
     if (is.null(tree_view))
... ...
@@ -2,9 +2,9 @@
2 2
 ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data
3 3
 ===========================================================================================================================
4 4
 
5
-[![releaseVersion](https://img.shields.io/badge/release%20version-1.6.9-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![develVersion](https://img.shields.io/badge/devel%20version-1.7.8-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) [![total](https://img.shields.io/badge/downloads-22537/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![month](https://img.shields.io/badge/downloads-1894/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) <img src="logo.png" align="right" />
5
+[![releaseVersion](https://img.shields.io/badge/release%20version-1.6.9-green.svg?style=flat)](https://bioconductor.org/packages/ggtree) [![develVersion](https://img.shields.io/badge/devel%20version-1.7.9-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) [![total](https://img.shields.io/badge/downloads-22704/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![month](https://img.shields.io/badge/downloads-1894/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) <img src="logo.png" align="right" />
6 6
 
7
-[![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--02--28-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)
7
+[![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--03--02-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)
8 8
 
9 9
 [![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)
10 10
 
... ...
@@ -51,7 +51,7 @@ For details, please visit our project website, <https://guangchuangyu.github.io/
51 51
 
52 52
 ### Download stats
53 53
 
54
-[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree) [![total](https://img.shields.io/badge/downloads-22537/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![month](https://img.shields.io/badge/downloads-1894/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
54
+[![download](http://www.bioconductor.org/shields/downloads/ggtree.svg)](https://bioconductor.org/packages/stats/bioc/ggtree) [![total](https://img.shields.io/badge/downloads-22704/total-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree) [![month](https://img.shields.io/badge/downloads-1894/month-blue.svg?style=flat)](https://bioconductor.org/packages/stats/bioc/ggtree)
55 55
 
56 56
          ++--------------------+--------------------+--------------------+--------------------+--------+
57 57
          |                                                                                        *    |
... ...
@@ -4,10 +4,10 @@
4 4
 \alias{geom_label2}
5 5
 \title{geom_label2}
6 6
 \usage{
7
-geom_label2(mapping = NULL, data = NULL, ..., family = "sans",
8
-  parse = FALSE, nudge_x = 0, nudge_y = 0, label.padding = unit(0.25,
9
-  "lines"), label.r = unit(0.15, "lines"), label.size = 0.25,
10
-  na.rm = TRUE, show.legend = NA, inherit.aes = TRUE)
7
+geom_label2(mapping = NULL, data = NULL, ..., position = "identity",
8
+  family = "sans", parse = FALSE, nudge_x = 0, nudge_y = 0,
9
+  label.padding = unit(0.25, "lines"), label.r = unit(0.15, "lines"),
10
+  label.size = 0.25, na.rm = TRUE, show.legend = NA, inherit.aes = TRUE)
11 11
 }
12 12
 \arguments{
13 13
 \item{mapping}{the aesthetic mapping}
... ...
@@ -17,6 +17,8 @@ only needed if you want to override he plot defaults.}
17 17
 
18 18
 \item{...}{other arguments passed on to 'layer'}
19 19
 
20
+\item{position}{The position adjustment to use for overlapping points on this layer}
21
+
20 22
 \item{family}{sans by default, can be any supported font}
21 23
 
22 24
 \item{parse}{if TRUE, the labels will be passd into expressions}
... ...
@@ -4,10 +4,9 @@
4 4
 \alias{geom_text2}
5 5
 \title{geom_text2}
6 6
 \usage{
7
-geom_text2(mapping = NULL, data = NULL, position = "identity",
7
+geom_text2(mapping = NULL, data = NULL, ..., position = "identity",
8 8
   family = "sans", parse = FALSE, na.rm = TRUE, show.legend = NA,
9
-  inherit.aes = TRUE, ..., nudge_x = 0, nudge_y = 0,
10
-  check_overlap = FALSE)
9
+  inherit.aes = TRUE, nudge_x = 0, nudge_y = 0, check_overlap = FALSE)
11 10
 }
12 11
 \arguments{
13 12
 \item{mapping}{the aesthetic mapping}
... ...
@@ -15,6 +14,8 @@ geom_text2(mapping = NULL, data = NULL, position = "identity",
15 14
 \item{data}{A layer specific dataset -
16 15
 only needed if you want to override he plot defaults.}
17 16
 
17
+\item{...}{other arguments passed on to 'layer'}
18
+
18 19
 \item{position}{The position adjustment to use for overlapping points on this layer}
19 20
 
20 21
 \item{family}{sans by default, can be any supported font}
... ...
@@ -27,8 +28,6 @@ only needed if you want to override he plot defaults.}
27 28
 
28 29
 \item{inherit.aes}{logical}
29 30
 
30
-\item{...}{other arguments passed on to 'layer'}
31
-
32 31
 \item{nudge_x}{horizontal adjustment}
33 32
 
34 33
 \item{nudge_y}{vertical adjustment}
... ...
@@ -4,7 +4,7 @@
4 4
 \alias{get_taxa_name}
5 5
 \title{get_taxa_name}
6 6
 \usage{
7
-get_taxa_name(tree_view = NULL, node)
7
+get_taxa_name(tree_view = NULL, node = NULL)
8 8
 }
9 9
 \arguments{
10 10
 \item{tree_view}{tree view}
... ...
@@ -15,7 +15,7 @@ get_taxa_name(tree_view = NULL, node)
15 15
 taxa name vector
16 16
 }
17 17
 \description{
18
-get taxa name of a selected node
18
+get taxa name of a selected node (or tree if node=NULL) sorted by their position in plotting
19 19
 }
20 20
 \author{
21 21
 Guangchuang Yu