1. ggtree
  2. R
  3. method-reroot.R
Browse code

mv reroot to treeio

Guangchuang Yu authored on 28/12/2018 09:34:31
Showing 1 changed files
R/method-reroot.R
History View file @ 91258270
1 1 
deleted file mode 100644
... ... 
@@ -1,73 +0,0 @@
1 
-
2 
-
3 
-##' reroot a tree
4 
-##'
5 
-##'
6 
-##' @rdname reroot-methods
7 
-##' @exportMethod reroot
8 
-setMethod("reroot", signature(object="phylo"),
9 
-          function(object, node, ...) {
10 
-              pos <- 0.5* object$edge.length[which(object$edge[,2] == node)]
11 
-
12 
-              ## @importFrom phytools reroot
13 
-              phytools <- "phytools"
14 
-              require(phytools, character.only = TRUE)
15 
-
16 
-              phytools_reroot <- eval(parse(text="phytools::reroot"))
17 
-
18 
-              tree <- phytools_reroot(object, node, pos)
19 
-              attr(tree, "reroot") <- TRUE
20 
-              node_map <- reroot_node_mapping(object, tree)
21 
-              attr(tree, "node_map") <- node_map
22 
-              return(tree)
23 
-          })
24 
-
25 
-
26 
-##' @rdname reroot-methods
27 
-##' @exportMethod reroot
28 
-setMethod("reroot", signature(object="treedata"),
29 
-        function(object, node, ...) {
30 
-        	# warning message
31 
-        	message("The use of this method may cause some node data to become incorrect (e.g. bootstrap values).")
32 
-
33 
-        	newobject <- object
34 
-
35 
-        	# ensure nodes/tips have a label to properly map @anc_seq/@tip_seq
36 
-        	tree <- object@phylo
37 
-        	if (is.null(tree$tip.label)) {
38 
-        		tree$tip.label <- as.character(1:Ntip(tree))
39 
-        	}
40 
-        	if (is.null(tree$node.label)) {
41 
-        		tree$node.label <- as.character((1:tree$Nnode) + Ntip(tree))
42 
-        	}
43 
-
44 
-            # reroot tree
45 
-            tree <- reroot(tree, node, ...)
46 
-            newobject@phylo <- tree
47 
-
48 
-            # update node numbers in data
49 
-            n.tips <- Ntip(tree)
50 
-            node_map<- attr(tree, "node_map")
51 
-
52 
-            update_data <- function(data, node_map) {
53 
-            	newdata <- data
54 
-            	newdata[match(node_map$from, data$node), 'node'] <- node_map$to
55 
-
56 
-            	# clear root data
57 
-            	root <- newdata$node == (n.tips + 1)
58 
-            	newdata[root,] <- NA
59 
-            	newdata[root,'node'] <- n.tips + 1
60 
-
61 
-            	return(newdata)
62 
-            }
63 
-
64 
-            if (nrow(newobject@data) > 0) {
65 
-            	newobject@data <- update_data(object@data, node_map)
66 
-            }
67 
-
68 
-            if (nrow(object@extraInfo) > 0) {
69 
-            	newobject@extraInfo <- update_data(object@extraInfo, node_map)
70 
-            }
71 
-
72 
-            return(newobject)
73 
-        })
Browse code

update object@extraInfo in reroot as well (@GuangchuangYu gave template for code change

brj1 authored on 14/11/2018 21:44:19
Showing 1 changed files
R/method-reroot.R
History View file @ dc3fb9fe
... ... 
@@ -30,6 +30,8 @@ setMethod("reroot", signature(object="treedata"),
30 30 
         	# warning message
31 31 
         	message("The use of this method may cause some node data to become incorrect (e.g. bootstrap values).")
32 32
33 
+        	newobject <- object
34 
+
33 35 
         	# ensure nodes/tips have a label to properly map @anc_seq/@tip_seq
34 36 
         	tree <- object@phylo
35 37 
         	if (is.null(tree$tip.label)) {
... ... 
@@ -41,14 +43,31 @@ setMethod("reroot", signature(object="treedata"),
41 43
42 44 
             # reroot tree
43 45 
             tree <- reroot(tree, node, ...)
44 
-            object@phylo <- tree
46 
+            newobject@phylo <- tree
45 47
46 48 
             # update node numbers in data
47 49 
             n.tips <- Ntip(tree)
48 
-            node_map <- attr(tree, "node_map")
49 
-            data <- object@data
50 
-            data$node[match(node_map$from, as.integer(data$node))] <- node_map$to
51 
-            object@data <- data
50 
+            node_map<- attr(tree, "node_map")
51 
+
52 
+            update_data <- function(data, node_map) {
53 
+            	newdata <- data
54 
+            	newdata[match(node_map$from, data$node), 'node'] <- node_map$to
55 
+
56 
+            	# clear root data
57 
+            	root <- newdata$node == (n.tips + 1)
58 
+            	newdata[root,] <- NA
59 
+            	newdata[root,'node'] <- n.tips + 1
60 
+
61 
+            	return(newdata)
62 
+            }
63 
+
64 
+            if (nrow(newobject@data) > 0) {
65 
+            	newobject@data <- update_data(object@data, node_map)
66 
+            }
67 
+
68 
+            if (nrow(object@extraInfo) > 0) {
69 
+            	newobject@extraInfo <- update_data(object@extraInfo, node_map)
70 
+            }
52 71
53 
-            return(object)
72 
+            return(newobject)
54 73 
         })
Browse code

fixed tips counting; added warning message; label unlabeled nodes/tips

brj1 authored on 13/11/2018 23:51:50
Showing 1 changed files
R/method-reroot.R
History View file @ de7c3290
... ... 
@@ -27,13 +27,24 @@ setMethod("reroot", signature(object="phylo"),
27 27 
 ##' @exportMethod reroot
28 28 
 setMethod("reroot", signature(object="treedata"),
29 29 
         function(object, node, ...) {
30 
-        	# reroot tree
31 
-            tree <- object@phylo
30 
+        	# warning message
31 
+        	message("The use of this method may cause some node data to become incorrect (e.g. bootstrap values).")
32 
+
33 
+        	# ensure nodes/tips have a label to properly map @anc_seq/@tip_seq
34 
+        	tree <- object@phylo
35 
+        	if (is.null(tree$tip.label)) {
36 
+        		tree$tip.label <- as.character(1:Ntip(tree))
37 
+        	}
38 
+        	if (is.null(tree$node.label)) {
39 
+        		tree$node.label <- as.character((1:tree$Nnode) + Ntip(tree))
40 
+        	}
41 
+
42 
+            # reroot tree
32 43 
             tree <- reroot(tree, node, ...)
33 44 
             object@phylo <- tree
34 45
35 46 
             # update node numbers in data
36 
-            n.tips <- length(tree$tip.label) # Is there a better way in ggtree/treeio to get the number of tips?
47 
+            n.tips <- Ntip(tree)
37 48 
             node_map <- attr(tree, "node_map")
38 49 
             data <- object@data
39 50 
             data$node[match(node_map$from, as.integer(data$node))] <- node_map$to
Browse code

fixed node reordering

brj1 authored on 10/11/2018 00:53:19
Showing 1 changed files
R/method-reroot.R
History View file @ 2f2d6001
... ... 
@@ -23,11 +23,21 @@ setMethod("reroot", signature(object="phylo"),
23 23 
           })
24 24
25 25
26 
-##' @method reroot treedata
27 
-##' @export
28 
-reroot.treedata <- function(object, node, ...) {
29 
-    tree <- object@phylo
30 
-    tree <- reroot(tree, node, ...)
31 
-    object@phylo <- tree
32 
-    object
33 
-}
26 
+##' @rdname reroot-methods
27 
+##' @exportMethod reroot
28 
+setMethod("reroot", signature(object="treedata"),
29 
+        function(object, node, ...) {
30 
+        	# reroot tree
31 
+            tree <- object@phylo
32 
+            tree <- reroot(tree, node, ...)
33 
+            object@phylo <- tree
34 
+
35 
+            # update node numbers in data
36 
+            n.tips <- length(tree$tip.label) # Is there a better way in ggtree/treeio to get the number of tips?
37 
+            node_map <- attr(tree, "node_map")
38 
+            data <- object@data
39 
+            data$node[match(node_map$from, as.integer(data$node))] <- node_map$to
40 
+            object@data <- data
41 
+
42 
+            return(object)
43 
+        })
Browse code

added reroot fr treedata type

brj1 authored on 23/10/2018 23:06:58
Showing 1 changed files
R/method-reroot.R
History View file @ 6171d4dc
... ... 
@@ -22,3 +22,12 @@ setMethod("reroot", signature(object="phylo"),
22 22 
               return(tree)
23 23 
           })
24 24
25 
+
26 
+##' @method reroot treedata
27 
+##' @export
28 
+reroot.treedata <- function(object, node, ...) {
29 
+    tree <- object@phylo
30 
+    tree <- reroot(tree, node, ...)
31 
+    object@phylo <- tree
32 
+    object
33 
+}
Browse code

update according to treeio and tidytree

guangchuang yu authored on 11/12/2017 14:18:00
Showing 1 changed files
R/method-reroot.R
History View file @ fcbe901f
... ... 
@@ -1,30 +1,4 @@
1 1
2 
-## ##' @rdname reroot-methods
3 
-## ##' @exportMethod reroot
4 
-## setMethod("reroot", signature(object="beast"),
5 
-##           function(object, node, ...) {
6 
-##               object@phylo <- reroot(object@phylo, node, ...)
7 
-
8 
-##               node_map <- attr(object@phylo, "node_map")
9 
-##               idx <- match(object@stats$node, node_map[,1])
10 
-##               object@stats$node <- node_map[idx, 2]
11 
-
12 
-##               return(object)
13 
-##           })
14 
-
15 
-## ##' @rdname reroot-methods
16 
-## ##' @exportMethod reroot
17 
-## setMethod("reroot", signature(object="raxml"),
18 
-##           function(object, node, ...) {
19 
-##               object@phylo <- reroot(object@phylo, node, ...)
20 
-
21 
-##               node_map <- attr(object@phylo, "node_map")
22 
-##               idx <- match(object@bootstrap$node, node_map[,1])
23 
-##               object@bootstrap$node <- node_map[idx, 2]
24 
-
25 
-##               return(object)
26 
-##           })
27 
-
28 2
29 3 
 ##' reroot a tree
30 4 
 ##'
Browse code

remove beast object support as read.beast output treedata object in treeio <2017-12-05, Tue>

guangchuang yu authored on 05/12/2017 11:05:11
Showing 1 changed files
R/method-reroot.R
History View file @ 13af7bc0
... ... 
@@ -1,16 +1,16 @@
1 1
2 
-##' @rdname reroot-methods
3 
-##' @exportMethod reroot
4 
-setMethod("reroot", signature(object="beast"),
5 
-          function(object, node, ...) {
6 
-              object@phylo <- reroot(object@phylo, node, ...)
2 
+## ##' @rdname reroot-methods
3 
+## ##' @exportMethod reroot
4 
+## setMethod("reroot", signature(object="beast"),
5 
+##           function(object, node, ...) {
6 
+##               object@phylo <- reroot(object@phylo, node, ...)
7 7
8 
-              node_map <- attr(object@phylo, "node_map")
9 
-              idx <- match(object@stats$node, node_map[,1])
10 
-              object@stats$node <- node_map[idx, 2]
8 
+##               node_map <- attr(object@phylo, "node_map")
9 
+##               idx <- match(object@stats$node, node_map[,1])
10 
+##               object@stats$node <- node_map[idx, 2]
11 11
12 
-              return(object)
13 
-          })
12 
+##               return(object)
13 
+##           })
14 14
15 15 
 ## ##' @rdname reroot-methods
16 16 
 ## ##' @exportMethod reroot
Browse code

remove apeBootstrap and raxml object support as they were removed from treeio

guangchuang yu authored on 28/02/2017 07:11:57
Showing 1 changed files
R/method-reroot.R
History View file @ 69a22a72
... ... 
@@ -8,27 +8,27 @@ setMethod("reroot", signature(object="beast"),
8 8 
               node_map <- attr(object@phylo, "node_map")
9 9 
               idx <- match(object@stats$node, node_map[,1])
10 10 
               object@stats$node <- node_map[idx, 2]
11 
-
11 
+
12 12 
               return(object)
13 13 
           })
14 14
15 
-##' @rdname reroot-methods
16 
-##' @exportMethod reroot
17 
-setMethod("reroot", signature(object="raxml"),
18 
-          function(object, node, ...) {
19 
-              object@phylo <- reroot(object@phylo, node, ...)
15 
+## ##' @rdname reroot-methods
16 
+## ##' @exportMethod reroot
17 
+## setMethod("reroot", signature(object="raxml"),
18 
+##           function(object, node, ...) {
19 
+##               object@phylo <- reroot(object@phylo, node, ...)
20 20
21 
-              node_map <- attr(object@phylo, "node_map")
22 
-              idx <- match(object@bootstrap$node, node_map[,1])
23 
-              object@bootstrap$node <- node_map[idx, 2]
24 
-
25 
-              return(object)
26 
-          })
21 
+##               node_map <- attr(object@phylo, "node_map")
22 
+##               idx <- match(object@bootstrap$node, node_map[,1])
23 
+##               object@bootstrap$node <- node_map[idx, 2]
24 
+
25 
+##               return(object)
26 
+##           })
27 27
28 28
29 29 
 ##' reroot a tree
30 30 
 ##'
31 
-##'
31 
+##'
32 32 
 ##' @rdname reroot-methods
33 33 
 ##' @exportMethod reroot
34 34 
 setMethod("reroot", signature(object="phylo"),
... ... 
@@ -38,7 +38,7 @@ setMethod("reroot", signature(object="phylo"),
38 38 
               ## @importFrom phytools reroot
39 39 
               phytools <- "phytools"
40 40 
               require(phytools, character.only = TRUE)
41 
-
41 
+
42 42 
               phytools_reroot <- eval(parse(text="phytools::reroot"))
43 43
44 44 
               tree <- phytools_reroot(object, node, pos)
Browse code

version 1.5.5

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

g.yu authored on 02/06/2016 03:14:43
Showing 1 changed files
R/method-reroot.R
History View file @ 328fdc06
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,50 @@
1 
+
2 
+##' @rdname reroot-methods
3 
+##' @exportMethod reroot
4 
+setMethod("reroot", signature(object="beast"),
5 
+          function(object, node, ...) {
6 
+              object@phylo <- reroot(object@phylo, node, ...)
7 
+
8 
+              node_map <- attr(object@phylo, "node_map")
9 
+              idx <- match(object@stats$node, node_map[,1])
10 
+              object@stats$node <- node_map[idx, 2]
11 
+
12 
+              return(object)
13 
+          })
14 
+
15 
+##' @rdname reroot-methods
16 
+##' @exportMethod reroot
17 
+setMethod("reroot", signature(object="raxml"),
18 
+          function(object, node, ...) {
19 
+              object@phylo <- reroot(object@phylo, node, ...)
20 
+
21 
+              node_map <- attr(object@phylo, "node_map")
22 
+              idx <- match(object@bootstrap$node, node_map[,1])
23 
+              object@bootstrap$node <- node_map[idx, 2]
24 
+
25 
+              return(object)
26 
+          })
27 
+
28 
+
29 
+##' reroot a tree
30 
+##'
31 
+##'
32 
+##' @rdname reroot-methods
33 
+##' @exportMethod reroot
34 
+setMethod("reroot", signature(object="phylo"),
35 
+          function(object, node, ...) {
36 
+              pos <- 0.5* object$edge.length[which(object$edge[,2] == node)]
37 
+
38 
+              ## @importFrom phytools reroot
39 
+              phytools <- "phytools"
40 
+              require(phytools, character.only = TRUE)
41 
+
42 
+              phytools_reroot <- eval(parse(text="phytools::reroot"))
43 
+
44 
+              tree <- phytools_reroot(object, node, pos)
45 
+              attr(tree, "reroot") <- TRUE
46 
+              node_map <- reroot_node_mapping(object, tree)
47 
+              attr(tree, "node_map") <- node_map
48 
+              return(tree)
49 
+          })
50 
+