Browse code

bug fixed of viewClade

Guangchuang Yu authored on 07/08/2018 12:07:15
Showing 22 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.13.2
5
+Version: 1.13.3
6 6
 Authors@R: c(
7 7
 	   person("Guangchuang", "Yu",     email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0002-6485-8781")),
8 8
 	   person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com",   role = c("aut", "ths")),
... ...
@@ -51,4 +51,4 @@ BugReports: https://github.com/GuangchuangYu/ggtree/issues
51 51
 Packaged: 2014-12-03 08:16:14 UTC; root
52 52
 biocViews: Alignment, Annotation, Clustering, DataImport,
53 53
     MultipleSequenceAlignment, ReproducibleResearch, Software, Visualization
54
-RoxygenNote: 6.0.1
54
+RoxygenNote: 6.1.0
... ...
@@ -1,3 +1,8 @@
1
+# ggtree 1.13.3
2
+
3
++ update `viewClade` according to the change of `ggplot2` (2018-08-07, Tue)
4
+  - <https://github.com/GuangchuangYu/ggtree/issues/188>
5
+  
1 6
 # ggtree 1.13.2
2 7
 
3 8
 + xmax_adjust  in `viewClade` (2018-07-21, Sat)
... ...
@@ -40,7 +40,7 @@ viewClade <- function(tree_view=NULL, node, xmax_adjust=0) {
40 40
     ## xd <- tree_view$data$branch.length[node]/2
41 41
 
42 42
     cpos <- get_clade_position(tree_view, node=node)
43
-    xmax <- ggplot_build(tree_view)$layout$panel_ranges[[1]]$x.range[2]
43
+    xmax <- ggplot_build(tree_view)$layout$panel_params[[1]]$x.range[2]
44 44
 
45 45
     attr(tree_view, 'viewClade') <- TRUE
46 46
     attr(tree_view, 'viewClade_node') <- node
... ...
@@ -6,8 +6,8 @@
6 6
 \usage{
7 7
 geom_cladelabel(node, label, offset = 0, offset.text = 0, extend = 0,
8 8
   align = FALSE, barsize = 0.5, fontsize = 3.88, angle = 0,
9
-  geom = "text", hjust = 0, color = NULL, fill = NA, family = "sans",
10
-  parse = FALSE, ...)
9
+  geom = "text", hjust = 0, color = NULL, fill = NA,
10
+  family = "sans", parse = FALSE, ...)
11 11
 }
12 12
 \arguments{
13 13
 \item{node}{selected node}
... ...
@@ -4,9 +4,10 @@
4 4
 \alias{geom_cladelabel2}
5 5
 \title{geom_cladelabel2}
6 6
 \usage{
7
-geom_cladelabel2(node, label, offset = 0, offset.text = 0, offset.bar = 0,
8
-  align = FALSE, barsize = 0.5, fontsize = 3.88, hjust = 0,
9
-  geom = "text", color = NULL, family = "sans", parse = FALSE, ...)
7
+geom_cladelabel2(node, label, offset = 0, offset.text = 0,
8
+  offset.bar = 0, align = FALSE, barsize = 0.5, fontsize = 3.88,
9
+  hjust = 0, geom = "text", color = NULL, family = "sans",
10
+  parse = FALSE, ...)
10 11
 }
11 12
 \arguments{
12 13
 \item{node}{selected node}
... ...
@@ -5,10 +5,10 @@
5 5
 \title{geom_label2}
6 6
 \usage{
7 7
 geom_label2(mapping = NULL, data = NULL, ..., stat = "identity",
8
-  position = "identity", family = "sans", parse = FALSE, nudge_x = 0,
9
-  nudge_y = 0, label.padding = unit(0.25, "lines"), label.r = unit(0.15,
10
-  "lines"), label.size = 0.25, na.rm = TRUE, show.legend = NA,
11
-  inherit.aes = TRUE)
8
+  position = "identity", family = "sans", parse = FALSE,
9
+  nudge_x = 0, nudge_y = 0, label.padding = unit(0.25, "lines"),
10
+  label.r = unit(0.15, "lines"), label.size = 0.25, na.rm = TRUE,
11
+  show.legend = NA, inherit.aes = TRUE)
12 12
 }
13 13
 \arguments{
14 14
 \item{mapping}{the aesthetic mapping}
... ...
@@ -4,8 +4,8 @@
4 4
 \alias{geom_nodelab}
5 5
 \title{geom_nodelab}
6 6
 \usage{
7
-geom_nodelab(mapping = NULL, nudge_x = 0, nudge_y = 0, geom = "text",
8
-  hjust = 0.5, ...)
7
+geom_nodelab(mapping = NULL, nudge_x = 0, nudge_y = 0,
8
+  geom = "text", hjust = 0.5, ...)
9 9
 }
10 10
 \arguments{
11 11
 \item{mapping}{aes mapping}
... ...
@@ -4,8 +4,8 @@
4 4
 \alias{geom_nodelab2}
5 5
 \title{@geom_nodelab2}
6 6
 \usage{
7
-geom_nodelab2(mapping = NULL, nudge_x = 0, nudge_y = 0, geom = "text",
8
-  hjust = 0.5, ...)
7
+geom_nodelab2(mapping = NULL, nudge_x = 0, nudge_y = 0,
8
+  geom = "text", hjust = 0.5, ...)
9 9
 }
10 10
 \arguments{
11 11
 \item{mapping}{aes mapping}
... ...
@@ -4,7 +4,8 @@
4 4
 \alias{geom_range}
5 5
 \title{geom_range}
6 6
 \usage{
7
-geom_range(range = "length_0.95_HPD", branch.length = "branch.length", ...)
7
+geom_range(range = "length_0.95_HPD", branch.length = "branch.length",
8
+  ...)
8 9
 }
9 10
 \arguments{
10 11
 \item{range}{range, e.g. "height_0.95_HPD"}
... ...
@@ -5,9 +5,9 @@
5 5
 \title{geom_strip}
6 6
 \usage{
7 7
 geom_strip(taxa1, taxa2, label = NA, offset = 0, offset.text = 0,
8
-  align = TRUE, barsize = 0.5, extend = 0, fontsize = 3.88, angle = 0,
9
-  geom = "text", hjust = 0, fill = NA, family = "sans", parse = FALSE,
10
-  ...)
8
+  align = TRUE, barsize = 0.5, extend = 0, fontsize = 3.88,
9
+  angle = 0, geom = "text", hjust = 0, fill = NA,
10
+  family = "sans", parse = FALSE, ...)
11 11
 }
12 12
 \arguments{
13 13
 \item{taxa1}{taxa1}
... ...
@@ -5,9 +5,9 @@
5 5
 \title{geom_text2}
6 6
 \usage{
7 7
 geom_text2(mapping = NULL, data = NULL, ..., stat = "identity",
8
-  position = "identity", family = "sans", parse = FALSE, na.rm = TRUE,
9
-  show.legend = NA, inherit.aes = TRUE, nudge_x = 0, nudge_y = 0,
10
-  check_overlap = FALSE)
8
+  position = "identity", family = "sans", parse = FALSE,
9
+  na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, nudge_x = 0,
10
+  nudge_y = 0, check_overlap = FALSE)
11 11
 }
12 12
 \arguments{
13 13
 \item{mapping}{the aesthetic mapping}
... ...
@@ -5,7 +5,8 @@
5 5
 \title{geom_tiplab}
6 6
 \usage{
7 7
 geom_tiplab(mapping = NULL, hjust = 0, align = FALSE,
8
-  linetype = "dotted", linesize = 0.5, geom = "text", offset = 0, ...)
8
+  linetype = "dotted", linesize = 0.5, geom = "text", offset = 0,
9
+  ...)
9 10
 }
10 11
 \arguments{
11 12
 \item{mapping}{aes mapping}
... ...
@@ -5,7 +5,8 @@
5 5
 \title{geom_treescale}
6 6
 \usage{
7 7
 geom_treescale(x = NULL, y = NULL, width = NULL, offset = NULL,
8
-  color = "black", linesize = 0.5, fontsize = 3.88, family = "sans")
8
+  color = "black", linesize = 0.5, fontsize = 3.88,
9
+  family = "sans")
9 10
 }
10 11
 \arguments{
11 12
 \item{x}{x position}
... ...
@@ -5,13 +5,13 @@
5 5
 \alias{ggtree}
6 6
 \alias{package-ggtree}
7 7
 \alias{ggtree-package}
8
-\alias{ggtree}
9 8
 \title{visualizing phylogenetic tree and heterogenous associated data based on grammar of graphics
10 9
 \code{ggtree} provides functions for visualizing phylogenetic tree and its associated data in R.}
11 10
 \usage{
12 11
 ggtree(tr, mapping = NULL, layout = "rectangular", open.angle = 0,
13
-  mrsd = NULL, as.Date = FALSE, yscale = "none", yscale_mapping = NULL,
14
-  ladderize = TRUE, right = FALSE, branch.length = "branch.length", ...)
12
+  mrsd = NULL, as.Date = FALSE, yscale = "none",
13
+  yscale_mapping = NULL, ladderize = TRUE, right = FALSE,
14
+  branch.length = "branch.length", ...)
15 15
 }
16 16
 \arguments{
17 17
 \item{tr}{phylo object}
... ...
@@ -4,9 +4,10 @@
4 4
 \alias{gheatmap}
5 5
 \title{gheatmap}
6 6
 \usage{
7
-gheatmap(p, data, offset = 0, width = 1, low = "green", high = "red",
8
-  color = "white", colnames = TRUE, colnames_position = "bottom",
9
-  colnames_angle = 0, colnames_level = NULL, colnames_offset_x = 0,
7
+gheatmap(p, data, offset = 0, width = 1, low = "green",
8
+  high = "red", color = "white", colnames = TRUE,
9
+  colnames_position = "bottom", colnames_angle = 0,
10
+  colnames_level = NULL, colnames_offset_x = 0,
10 11
   colnames_offset_y = 0, font.size = 4, hjust = 0.5)
11 12
 }
12 13
 \arguments{
... ...
@@ -3,7 +3,6 @@
3 3
 \docType{methods}
4 4
 \name{gzoom}
5 5
 \alias{gzoom}
6
-\alias{gzoom}
7 6
 \alias{gzoom,ggtree-method}
8 7
 \alias{gzoom,treedata-method}
9 8
 \alias{gzoom,phylo-method}
... ...
@@ -14,8 +13,8 @@ gzoom(object, focus, subtree = FALSE, widths = c(0.3, 0.7), ...)
14 13
 \S4method{gzoom}{ggtree}(object, focus, widths = c(0.3, 0.7),
15 14
   xmax_adjust = 0)
16 15
 
17
-\S4method{gzoom}{treedata}(object, focus, subtree = FALSE, widths = c(0.3,
18
-  0.7))
16
+\S4method{gzoom}{treedata}(object, focus, subtree = FALSE,
17
+  widths = c(0.3, 0.7))
19 18
 
20 19
 \S4method{gzoom}{phylo}(object, focus, subtree = FALSE, widths = c(0.3,
21 20
   0.7))
... ...
@@ -37,5 +36,9 @@ gzoom(object, focus, subtree = FALSE, widths = c(0.3, 0.7), ...)
37 36
 figure
38 37
 }
39 38
 \description{
39
+gzoom method
40
+
41
+gzoom method
42
+
40 43
 zoom selected subtree
41 44
 }
... ...
@@ -4,8 +4,8 @@
4 4
 \alias{inset}
5 5
 \title{inset}
6 6
 \usage{
7
-inset(tree_view, insets, width, height, hjust = 0, vjust = 0, x = "node",
8
-  reverse_x = FALSE, reverse_y = FALSE)
7
+inset(tree_view, insets, width, height, hjust = 0, vjust = 0,
8
+  x = "node", reverse_x = FALSE, reverse_y = FALSE)
9 9
 }
10 10
 \arguments{
11 11
 \item{tree_view}{tree view}
... ...
@@ -4,8 +4,8 @@
4 4
 \alias{msaplot}
5 5
 \title{msaplot}
6 6
 \usage{
7
-msaplot(p, fasta, offset = 0, width = 1, color = NULL, window = NULL,
8
-  bg_line = TRUE, height = 0.8)
7
+msaplot(p, fasta, offset = 0, width = 1, color = NULL,
8
+  window = NULL, bg_line = TRUE, height = 0.8)
9 9
 }
10 10
 \arguments{
11 11
 \item{p}{tree view}
... ...
@@ -4,8 +4,8 @@
4 4
 \alias{phylopic}
5 5
 \title{phylopic}
6 6
 \usage{
7
-phylopic(tree_view, phylopic_id, size = 512, color = "black", alpha = 0.5,
8
-  node = NULL, x = NULL, y = NULL, width = 0.1)
7
+phylopic(tree_view, phylopic_id, size = 512, color = "black",
8
+  alpha = 0.5, node = NULL, x = NULL, y = NULL, width = 0.1)
9 9
 }
10 10
 \arguments{
11 11
 \item{tree_view}{tree view}
... ...
@@ -4,67 +4,35 @@
4 4
 \name{reexports}
5 5
 \alias{reexports}
6 6
 \alias{rtree}
7
-\alias{reexports}
8 7
 \alias{read.tree}
9
-\alias{reexports}
10 8
 \alias{read.nexus}
11
-\alias{reexports}
12 9
 \alias{groupOTU}
13
-\alias{reexports}
14 10
 \alias{groupClade}
15
-\alias{reexports}
16 11
 \alias{collapse}
17
-\alias{reexports}
18 12
 \alias{fortify}
19
-\alias{reexports}
20 13
 \alias{ggplot}
21
-\alias{reexports}
22 14
 \alias{xlim}
23
-\alias{reexports}
24 15
 \alias{theme}
25
-\alias{reexports}
26 16
 \alias{ggsave}
27
-\alias{reexports}
28 17
 \alias{aes}
29
-\alias{reexports}
30
-\alias{fortify}
31
-\alias{reexports}
32 18
 \alias{geom_text}
33
-\alias{reexports}
34 19
 \alias{geom_label}
35
-\alias{reexports}
36 20
 \alias{geom_point}
37
-\alias{reexports}
38 21
 \alias{read.astral}
39
-\alias{reexports}
40 22
 \alias{read.beast}
41
-\alias{reexports}
42 23
 \alias{read.codeml}
43
-\alias{reexports}
44 24
 \alias{read.codeml_mlc}
45
-\alias{reexports}
46 25
 \alias{read.hyphy}
47
-\alias{reexports}
48 26
 \alias{read.iqtree}
49
-\alias{reexports}
50 27
 \alias{read.jplace}
51
-\alias{reexports}
52 28
 \alias{read.jtree}
53
-\alias{reexports}
54 29
 \alias{read.mrbayes}
55
-\alias{reexports}
56 30
 \alias{read.newick}
57
-\alias{reexports}
58 31
 \alias{read.nhx}
59
-\alias{reexports}
60 32
 \alias{read.paml_rst}
61
-\alias{reexports}
62 33
 \alias{read.phylip}
63
-\alias{reexports}
64 34
 \alias{read.phyloT}
65
-\alias{reexports}
66 35
 \alias{read.r8s}
67
-\alias{reexports}
68 36
 \alias{read.raxml}
69 37
 \title{Objects exported from other packages}
70 38
 \keyword{internal}
... ...
@@ -21,5 +21,7 @@ reroot(object, node, ...)
21 21
 tree object
22 22
 }
23 23
 \description{
24
+reroot method
25
+
24 26
 reroot a tree
25 27
 }
... ...
@@ -24,5 +24,7 @@ scale_color(object, by, ...)
24 24
 color vector
25 25
 }
26 26
 \description{
27
+scale_color method
28
+
27 29
 scale color by a numerical tree attribute
28 30
 }