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

fortify methods for agnes, diana and twins

Guangchuang Yu authored on 30/08/2019 05:01:11
Showing 1 changed files
R/method-groupClade.R
History View file @ dce1205a
... ... 
@@ -3,4 +3,5 @@
3 3 
 ##' @export
4 4 
 groupClade.ggtree <- function(.data, .node, group_name = "group", ...) {
5 5 
     .data$data <- groupClade(.data$data, .node, group_name, ...)
6 
+    return(.data)
6 7 
 }
Browse code

update according to treeio and tidytree

guangchuang yu authored on 11/12/2017 14:18:00
Showing 1 changed files
R/method-groupClade.R
History View file @ fcbe901f
... ... 
@@ -1,109 +1,6 @@
1 
-## ##' @rdname groupClade-methods
2 
-## ##' @exportMethod groupClade
3 
-## setMethod("groupClade", signature(object="beast"),
4 
-##           function(object, node, group_name="group") {
5 
-##               groupClade_(object, node, group_name)
6 
-##           })
7 
-
8 
-## ##' @rdname groupClade-methods
9 
-## ##' @exportMethod groupClade
10 
-## setMethod("groupClade", signature(object="codeml"),
11 
-##           function(object, node, group_name="group") {
12 
-##               groupClade_(object, node, group_name)
13 
-##           }
14 
-##           )
15 
-
16 
-##' groupClade method for ggtree object
17 
-##'
18 
-##'
19 
-##' @name groupClade
20 
-##' @title groupClade method
21 
-##' @rdname groupClade-methods
22 
-##' @param object ggtree object
23 
-##' @param node internal node number
24 
-##' @param group_name name of the group
25 
-##' @importFrom treeio groupClade
26 
-##' @exportMethod groupClade
27 
-##' @aliases groupClade,ggtree-method
28 
-setMethod("groupClade", signature(object="ggtree"),
29 
-          function(object, node, group_name) {
30 
-              groupClade.ggtree(object, node, group_name)
31 
-          })
32 
-
33 
-## ##' @rdname groupClade-methods
34 
-## ##' @exportMethod groupClade
35 
-## setMethod("groupClade", signature(object="jplace"),
36 
-##           function(object, node, group_name="group") {
37 
-##               groupClade_(object, node, group_name)
38 
-##           }
39 
-##           )
40 
-
41 
-## ##' group selected clade
42 
-## ##'
43 
-## ##'
44 
-## ##' @rdname groupClade-methods
45 
-## ##' @exportMethod groupClade
46 
-## setMethod("groupClade", signature(object="nhx"),
47 
-##           function(object, node, group_name="group") {
48 
-##               groupClade_(object, node, group_name)
49 
-##           })
50 
-
51 
-## ##' @rdname groupClade-methods
52 
-## ##' @exportMethod groupClade
53 
-## setMethod("groupClade", signature(object="phylip"),
54 
-##           function(object, node, group_name="group") {
55 
-##               groupClade_(object, node, group_name)
56 
-##           })
57 
-
58 
-
59 
-## ##' @rdname groupClade-methods
60 
-## ##' @exportMethod groupClade
61 
-## setMethod("groupClade", signature(object="phylo"),
62 
-##           function(object, node, group_name="group") {
63 
-##               groupClade.phylo(object, node, group_name)
64 
-##           })
65 
-
66 
-
67 
-
68 
-## groupClade.phylo <- function(object, node, group_name) {
69 
-##     if (length(node) == 1) {
70 
-##         clade <- extract.clade(object, node)
71 
-##         tips <- clade$tip.label
72 
-##     } else {
73 
-##         tips <- lapply(node, function(x) {
74 
-##             clade <- extract.clade(object, x)
75 
-##             clade$tip.label
76 
-##         })
77 
-##     }
78 
-
79 
-##     groupOTU.phylo(object, tips, group_name)
80 
-## }
81 
-
82 
-
83 
-## groupClade_ <- function(object, node, group_name) {
84 
-##     if (is(object, "phylo")) {
85 
-##         object <- groupClade.phylo(object, node, group_name)
86 
-##     } else {
87 
-##         object@phylo <- groupClade.phylo(get.tree(object), node, group_name)
88 
-##     }
89 
-##     return(object)
90 
-## }
91 
-
92 
-
93 
-groupClade.ggtree <- function(object, nodes, group_name) {
94 
-    df <- object$data
95 
-    df[, group_name] <- 0
96 
-    for (node in nodes) {
97 
-        df <- groupClade.tbl(df, node, group_name)
98 
-    }
99 
-    df[, group_name] <- factor(df[[group_name]])
100 
-    object$data <- df
101 
-    return(object)
102 
-}
103 
-
104 
-groupClade.tbl <- function(df, node, group_name) {
105 
-    foc <- c(node, get.offspring.df(df, node))
106 
-    idx <- match(foc, df$node)
107 
-    df[idx, group_name] <- max(df[[group_name]]) + 1
108 
-    return(df)
1 
+##' @importFrom tidytree groupClade
2 
+##' @method groupClade ggtree
3 
+##' @export
4 
+groupClade.ggtree <- function(.data, .node, group_name = "group", ...) {
5 
+    .data$data <- groupClade(.data$data, .node, group_name, ...)
109 6 
 }
Browse code

remove paml_rst, codeml_mlc, codeml and jplace fortify methods according to the change of treeio (v = 1.3.3)

guangchuang yu authored on 07/12/2017 07:21:58
Showing 1 changed files
R/method-groupClade.R
History View file @ 6be958c5
... ... 
@@ -94,16 +94,16 @@ groupClade.ggtree <- function(object, nodes, group_name) {
94 94 
     df <- object$data
95 95 
     df[, group_name] <- 0
96 96 
     for (node in nodes) {
97 
-        df <- groupClade.df(df, node, group_name)
97 
+        df <- groupClade.tbl(df, node, group_name)
98 98 
     }
99 
-    df[, group_name] <- factor(df[, group_name])
99 
+    df[, group_name] <- factor(df[[group_name]])
100 100 
     object$data <- df
101 101 
     return(object)
102 102 
 }
103 103
104 
-groupClade.df <- function(df, node, group_name) {
104 
+groupClade.tbl <- function(df, node, group_name) {
105 105 
     foc <- c(node, get.offspring.df(df, node))
106 106 
     idx <- match(foc, df$node)
107 
-    df[idx, group_name] <- max(df[, group_name]) + 1
107 
+    df[idx, group_name] <- max(df[[group_name]]) + 1
108 108 
     return(df)
109 109 
 }
Browse code

move code to treeio

guangchuang yu authored on 21/12/2016 08:57:38
Showing 1 changed files
R/method-groupClade.R
History View file @ 1d7f426b
... ... 
@@ -13,11 +13,18 @@
13 13 
 ##           }
14 14 
 ##           )
15 15
16 
+##' groupClade method for ggtree object
17 
+##'
18 
+##'
16 19 
 ##' @name groupClade
17 20 
 ##' @title groupClade method
18 21 
 ##' @rdname groupClade-methods
22 
+##' @param object ggtree object
23 
+##' @param node internal node number
24 
+##' @param group_name name of the group
19 25 
 ##' @importFrom treeio groupClade
20 26 
 ##' @exportMethod groupClade
27 
+##' @aliases groupClade,ggtree-method
21 28 
 setMethod("groupClade", signature(object="ggtree"),
22 29 
           function(object, node, group_name) {
23 30 
               groupClade.ggtree(object, node, group_name)
Browse code

depends treeio

GuangchuangYu authored on 20/12/2016 16:39:07
Showing 1 changed files
R/method-groupClade.R
History View file @ 817c093d
... ... 
@@ -1,83 +1,86 @@
1 
+## ##' @rdname groupClade-methods
2 
+## ##' @exportMethod groupClade
3 
+## setMethod("groupClade", signature(object="beast"),
4 
+##           function(object, node, group_name="group") {
5 
+##               groupClade_(object, node, group_name)
6 
+##           })
7 
+
8 
+## ##' @rdname groupClade-methods
9 
+## ##' @exportMethod groupClade
10 
+## setMethod("groupClade", signature(object="codeml"),
11 
+##           function(object, node, group_name="group") {
12 
+##               groupClade_(object, node, group_name)
13 
+##           }
14 
+##           )
15 
+
16 
+##' @name groupClade
17 
+##' @title groupClade method
1 18 
 ##' @rdname groupClade-methods
2 
-##' @exportMethod groupClade
3 
-setMethod("groupClade", signature(object="beast"),
4 
-          function(object, node, group_name="group") {
5 
-              groupClade_(object, node, group_name)
6 
-          })
7 
-
8 
-##' @rdname groupClade-methods
9 
-##' @exportMethod groupClade
10 
-setMethod("groupClade", signature(object="codeml"),
11 
-          function(object, node, group_name="group") {
12 
-              groupClade_(object, node, group_name)
13 
-          }
14 
-          )
15 
-
16 
-##' @rdname groupClade-methods
19 
+##' @importFrom treeio groupClade
17 20 
 ##' @exportMethod groupClade
18 21 
 setMethod("groupClade", signature(object="ggtree"),
19 22 
           function(object, node, group_name) {
20 23 
               groupClade.ggtree(object, node, group_name)
21 24 
           })
22 25
23 
-##' @rdname groupClade-methods
24 
-##' @exportMethod groupClade
25 
-setMethod("groupClade", signature(object="jplace"),
26 
-          function(object, node, group_name="group") {
27 
-              groupClade_(object, node, group_name)
28 
-          }
29 
-          )
30 
-
31 
-##' group selected clade
32 
-##'
33 
-##'
34 
-##' @rdname groupClade-methods
35 
-##' @exportMethod groupClade
36 
-setMethod("groupClade", signature(object="nhx"),
37 
-          function(object, node, group_name="group") {
38 
-              groupClade_(object, node, group_name)
39 
-          })
40 
-
41 
-##' @rdname groupClade-methods
42 
-##' @exportMethod groupClade
43 
-setMethod("groupClade", signature(object="phylip"),
44 
-          function(object, node, group_name="group") {
45 
-              groupClade_(object, node, group_name)
46 
-          })
47 
-
48 
-
49 
-##' @rdname groupClade-methods
50 
-##' @exportMethod groupClade
51 
-setMethod("groupClade", signature(object="phylo"),
52 
-          function(object, node, group_name="group") {
53 
-              groupClade.phylo(object, node, group_name)
54 
-          })
55 
-
56 
-
57 
-
58 
-groupClade.phylo <- function(object, node, group_name) {
59 
-    if (length(node) == 1) {
60 
-        clade <- extract.clade(object, node)
61 
-        tips <- clade$tip.label
62 
-    } else {
63 
-        tips <- lapply(node, function(x) {
64 
-            clade <- extract.clade(object, x)
65 
-            clade$tip.label
66 
-        })
67 
-    }
68 
-
69 
-    groupOTU.phylo(object, tips, group_name)
70 
-}
71 
-
72 
-
73 
-groupClade_ <- function(object, node, group_name) {
74 
-    if (is(object, "phylo")) {
75 
-        object <- groupClade.phylo(object, node, group_name)
76 
-    } else {
77 
-        object@phylo <- groupClade.phylo(get.tree(object), node, group_name)
78 
-    }
79 
-    return(object)
80 
-}
26 
+## ##' @rdname groupClade-methods
27 
+## ##' @exportMethod groupClade
28 
+## setMethod("groupClade", signature(object="jplace"),
29 
+##           function(object, node, group_name="group") {
30 
+##               groupClade_(object, node, group_name)
31 
+##           }
32 
+##           )
33 
+
34 
+## ##' group selected clade
35 
+## ##'
36 
+## ##'
37 
+## ##' @rdname groupClade-methods
38 
+## ##' @exportMethod groupClade
39 
+## setMethod("groupClade", signature(object="nhx"),
40 
+##           function(object, node, group_name="group") {
41 
+##               groupClade_(object, node, group_name)
42 
+##           })
43 
+
44 
+## ##' @rdname groupClade-methods
45 
+## ##' @exportMethod groupClade
46 
+## setMethod("groupClade", signature(object="phylip"),
47 
+##           function(object, node, group_name="group") {
48 
+##               groupClade_(object, node, group_name)
49 
+##           })
50 
+
51 
+
52 
+## ##' @rdname groupClade-methods
53 
+## ##' @exportMethod groupClade
54 
+## setMethod("groupClade", signature(object="phylo"),
55 
+##           function(object, node, group_name="group") {
56 
+##               groupClade.phylo(object, node, group_name)
57 
+##           })
58 
+
59 
+
60 
+
61 
+## groupClade.phylo <- function(object, node, group_name) {
62 
+##     if (length(node) == 1) {
63 
+##         clade <- extract.clade(object, node)
64 
+##         tips <- clade$tip.label
65 
+##     } else {
66 
+##         tips <- lapply(node, function(x) {
67 
+##             clade <- extract.clade(object, x)
68 
+##             clade$tip.label
69 
+##         })
70 
+##     }
71 
+
72 
+##     groupOTU.phylo(object, tips, group_name)
73 
+## }
74 
+
75 
+
76 
+## groupClade_ <- function(object, node, group_name) {
77 
+##     if (is(object, "phylo")) {
78 
+##         object <- groupClade.phylo(object, node, group_name)
79 
+##     } else {
80 
+##         object@phylo <- groupClade.phylo(get.tree(object), node, group_name)
81 
+##     }
82 
+##     return(object)
83 
+## }
81 84
82 85
83 86 
 groupClade.ggtree <- function(object, nodes, group_name) {
Browse code

fixed R check

guangchuang yu authored on 06/12/2016 12:05:09
Showing 1 changed files
R/method-groupClade.R
History View file @ 9bd4fbab
... ... 
@@ -15,19 +15,11 @@ setMethod("groupClade", signature(object="codeml"),
15 15
16 16 
 ##' @rdname groupClade-methods
17 17 
 ##' @exportMethod groupClade
18 
-setMethod("groupClade", signature(object="gg"),
18 
+setMethod("groupClade", signature(object="ggtree"),
19 19 
           function(object, node, group_name) {
20 
-              groupClade.ggplot(object, node, group_name)
20 
+              groupClade.ggtree(object, node, group_name)
21 21 
           })
22 22
23 
-##' @rdname groupClade-methods
24 
-##' @exportMethod groupClade
25 
-setMethod("groupClade", signature(object="ggplot"),
26 
-          function(object, node, group_name) {
27 
-              groupClade.ggplot(object, node, group_name)
28 
-          })
29 
-
30 
-
31 23 
 ##' @rdname groupClade-methods
32 24 
 ##' @exportMethod groupClade
33 25 
 setMethod("groupClade", signature(object="jplace"),
... ... 
@@ -38,7 +30,7 @@ setMethod("groupClade", signature(object="jplace"),
38 30
39 31 
 ##' group selected clade
40 32 
 ##'
41 
-##'
33 
+##'
42 34 
 ##' @rdname groupClade-methods
43 35 
 ##' @exportMethod groupClade
44 36 
 setMethod("groupClade", signature(object="nhx"),
... ... 
@@ -73,7 +65,7 @@ groupClade.phylo <- function(object, node, group_name) {
73 65 
             clade$tip.label
74 66 
         })
75 67 
     }
76 
-
68 
+
77 69 
     groupOTU.phylo(object, tips, group_name)
78 70 
 }
79 71
... ... 
@@ -88,7 +80,7 @@ groupClade_ <- function(object, node, group_name) {
88 80 
 }
89 81
90 82
91 
-groupClade.ggplot <- function(object, nodes, group_name) {
83 
+groupClade.ggtree <- function(object, nodes, group_name) {
92 84 
     df <- object$data
93 85 
     df[, group_name] <- 0
94 86 
     for (node in nodes) {
Browse code

support phylip format

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

g.yu authored on 15/01/2016 04:55:05
Showing 1 changed files
R/method-groupClade.R
History View file @ 6f076280
... ... 
@@ -1,28 +1,40 @@
1 
-
2 1 
 ##' @rdname groupClade-methods
3 2 
 ##' @exportMethod groupClade
4 
-setMethod("groupClade", signature(object="phylo"),
3 
+setMethod("groupClade", signature(object="beast"),
5 4 
           function(object, node, group_name="group") {
6 
-              groupClade.phylo(object, node, group_name)
5 
+              groupClade_(object, node, group_name)
7 6 
           })
8 7
9 
-groupClade.phylo <- function(object, node, group_name) {
10 
-    if (length(node) == 1) {
11 
-        clade <- extract.clade(object, node)
12 
-        tips <- clade$tip.label
13 
-    } else {
14 
-        tips <- lapply(node, function(x) {
15 
-            clade <- extract.clade(object, x)
16 
-            clade$tip.label
17 
-        })
18 
-    }
19 
-
20 
-    groupOTU.phylo(object, tips, group_name)
21 
-}
8 
+##' @rdname groupClade-methods
9 
+##' @exportMethod groupClade
10 
+setMethod("groupClade", signature(object="codeml"),
11 
+          function(object, node, group_name="group") {
12 
+              groupClade_(object, node, group_name)
13 
+          }
14 
+          )
22 15
16 
+##' @rdname groupClade-methods
17 
+##' @exportMethod groupClade
18 
+setMethod("groupClade", signature(object="gg"),
19 
+          function(object, node, group_name) {
20 
+              groupClade.ggplot(object, node, group_name)
21 
+          })
23 22
23 
+##' @rdname groupClade-methods
24 
+##' @exportMethod groupClade
25 
+setMethod("groupClade", signature(object="ggplot"),
26 
+          function(object, node, group_name) {
27 
+              groupClade.ggplot(object, node, group_name)
28 
+          })
24 29
25 30
31 
+##' @rdname groupClade-methods
32 
+##' @exportMethod groupClade
33 
+setMethod("groupClade", signature(object="jplace"),
34 
+          function(object, node, group_name="group") {
35 
+              groupClade_(object, node, group_name)
36 
+          }
37 
+          )
26 38
27 39 
 ##' group selected clade
28 40 
 ##'
... ... 
@@ -34,19 +46,62 @@ setMethod("groupClade", signature(object="nhx"),
34 46 
               groupClade_(object, node, group_name)
35 47 
           })
36 48
37 
-
38 49 
 ##' @rdname groupClade-methods
39 50 
 ##' @exportMethod groupClade
40 
-setMethod("groupClade", signature(object="ggplot"),
41 
-          function(object, node, group_name) {
42 
-              groupClade.ggplot(object, node, group_name)
51 
+setMethod("groupClade", signature(object="phylip"),
52 
+          function(object, node, group_name="group") {
53 
+              groupClade_(object, node, group_name)
43 54 
           })
44 55
45 56
46 57 
 ##' @rdname groupClade-methods
47 58 
 ##' @exportMethod groupClade
48 
-setMethod("groupClade", signature(object="gg"),
49 
-          function(object, node, group_name) {
50 
-              groupClade.ggplot(object, node, group_name)
59 
+setMethod("groupClade", signature(object="phylo"),
60 
+          function(object, node, group_name="group") {
61 
+              groupClade.phylo(object, node, group_name)
51 62 
           })
52 63
64 
+
65 
+
66 
+groupClade.phylo <- function(object, node, group_name) {
67 
+    if (length(node) == 1) {
68 
+        clade <- extract.clade(object, node)
69 
+        tips <- clade$tip.label
70 
+    } else {
71 
+        tips <- lapply(node, function(x) {
72 
+            clade <- extract.clade(object, x)
73 
+            clade$tip.label
74 
+        })
75 
+    }
76 
+
77 
+    groupOTU.phylo(object, tips, group_name)
78 
+}
79 
+
80 
+
81 
+groupClade_ <- function(object, node, group_name) {
82 
+    if (is(object, "phylo")) {
83 
+        object <- groupClade.phylo(object, node, group_name)
84 
+    } else {
85 
+        object@phylo <- groupClade.phylo(get.tree(object), node, group_name)
86 
+    }
87 
+    return(object)
88 
+}
89 
+
90 
+
91 
+groupClade.ggplot <- function(object, nodes, group_name) {
92 
+    df <- object$data
93 
+    df[, group_name] <- 0
94 
+    for (node in nodes) {
95 
+        df <- groupClade.df(df, node, group_name)
96 
+    }
97 
+    df[, group_name] <- factor(df[, group_name])
98 
+    object$data <- df
99 
+    return(object)
100 
+}
101 
+
102 
+groupClade.df <- function(df, node, group_name) {
103 
+    foc <- c(node, get.offspring.df(df, node))
104 
+    idx <- match(foc, df$node)
105 
+    df[idx, group_name] <- max(df[, group_name]) + 1
106 
+    return(df)
107 
+}
Browse code

update ggtree with new features according to ggplot2 v2

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

g.yu authored on 29/12/2015 11:53:44
Showing 1 changed files
R/method-groupClade.R
History View file @ 25ce9608
... ... 
@@ -1,3 +1,29 @@
1 
+
2 
+##' @rdname groupClade-methods
3 
+##' @exportMethod groupClade
4 
+setMethod("groupClade", signature(object="phylo"),
5 
+          function(object, node, group_name="group") {
6 
+              groupClade.phylo(object, node, group_name)
7 
+          })
8 
+
9 
+groupClade.phylo <- function(object, node, group_name) {
10 
+    if (length(node) == 1) {
11 
+        clade <- extract.clade(object, node)
12 
+        tips <- clade$tip.label
13 
+    } else {
14 
+        tips <- lapply(node, function(x) {
15 
+            clade <- extract.clade(object, x)
16 
+            clade$tip.label
17 
+        })
18 
+    }
19 
+
20 
+    groupOTU.phylo(object, tips, group_name)
21 
+}
22 
+
23 
+
24 
+
25 
+
26 
+
1 27 
 ##' group selected clade
2 28 
 ##'
3 29 
 ##'
Browse code

clean up code

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

g.yu authored on 22/12/2015 04:20:56
Showing 1 changed files
R/method-groupClade.R
History View file @ ca2be470
... ... 
@@ -9,3 +9,18 @@ setMethod("groupClade", signature(object="nhx"),
9 9 
           })
10 10
11 11
12 
+##' @rdname groupClade-methods
13 
+##' @exportMethod groupClade
14 
+setMethod("groupClade", signature(object="ggplot"),
15 
+          function(object, node, group_name) {
16 
+              groupClade.ggplot(object, node, group_name)
17 
+          })
18 
+
19 
+
20 
+##' @rdname groupClade-methods
21 
+##' @exportMethod groupClade
22 
+setMethod("groupClade", signature(object="gg"),
23 
+          function(object, node, group_name) {
24 
+              groupClade.ggplot(object, node, group_name)
25 
+          })
26 
+
Browse code

lots of new layers

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

g.yu authored on 22/12/2015 04:13:13
Showing 1 changed files
R/method-groupClade.R
History View file @ 3e4b5998
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,11 @@
1 
+##' group selected clade
2 
+##'
3 
+##'
4 
+##' @rdname groupClade-methods
5 
+##' @exportMethod groupClade
6 
+setMethod("groupClade", signature(object="nhx"),
7 
+          function(object, node, group_name="group") {
8 
+              groupClade_(object, node, group_name)
9 
+          })
10 
+
11 
+