Browse code

clean up code #445

Guangchuang Yu authored on 12/10/2021 08:50:46
Showing1 changed files
... ...
@@ -764,29 +764,25 @@ getXcoord2 <- function(x, root, parent, child, len, start=0, rev=FALSE) {
764 764
         direction <- -1
765 765
     }
766 766
 
767
-    if (any(len < 0) && (is.null(getOption("ignore.negative.edge")) || !getOption("ignore.negative.edge"))){
767
+    ignore_negative_edge <- getOption("ignore.negative.edge", default=FALSE)
768
+
769
+    if (any(len < 0) && !ignore_negative_edge) {
768 770
         warning_wrap("The tree contained negative ", 
769
-                  ifelse(sum(len < 0)>1, "edge lengths", "edge length"),
770
-                  ". If you want to ignore the ", 
771
-                  ifelse(sum(len<0) > 1, "edges", "edge"),
772
-                  ", you can set 'options(ignore.negative.edge=TRUE)', then re-run ggtree."
773
-        )
771
+                     ifelse(sum(len < 0)>1, "edge lengths", "edge length"),
772
+                     ". If you want to ignore the ", 
773
+                     ifelse(sum(len<0) > 1, "edges", "edge"),
774
+                     ", you can set 'options(ignore.negative.edge=TRUE)', then re-run ggtree."
775
+                     )
774 776
     }
775
-
776
-    if (getOption("ignore.negative.edge", default=FALSE)){
777
-        while(anyNA(x)) {
778
-            idx <- which(parent %in% currentNode)
779
-            newNode <- child[idx]
777
+    while(anyNA(x)) {
778
+        idx <- which(parent %in% currentNode)
779
+        newNode <- child[idx]
780
+        if (ignore_negative_edge){
780 781
             x[newNode] <- x[parent[idx]]+len[idx] * direction * sign(len[idx])
781
-            currentNode <- newNode
782
-        }
783
-    }else{
784
-        while(anyNA(x)) {
785
-            idx <- which(parent %in% currentNode)
786
-            newNode <- child[idx]
782
+        } else {
787 783
             x[newNode] <- x[parent[idx]]+len[idx] * direction
788
-            currentNode <- newNode
789
-        }        
784
+        }
785
+        currentNode <- newNode
790 786
     }
791 787
     
792 788
     return(x)
xiangpin authored on 12/10/2021 08:33:52
Showing1 changed files
... ...
@@ -769,7 +769,7 @@ getXcoord2 <- function(x, root, parent, child, len, start=0, rev=FALSE) {
769 769
                   ifelse(sum(len < 0)>1, "edge lengths", "edge length"),
770 770
                   ". If you want to ignore the ", 
771 771
                   ifelse(sum(len<0) > 1, "edges", "edge"),
772
-                  "you can set 'options(ignore.negative.edge=TRUE)', then re-run ggtree."
772
+                  ", you can set 'options(ignore.negative.edge=TRUE)', then re-run ggtree."
773 773
         )
774 774
     }
775 775
 
Browse code

ignore negative edge introduce options(ignore.negative.edge=TRUE)

xiangpin authored on 12/10/2021 08:00:40
Showing1 changed files
... ...
@@ -764,13 +764,31 @@ getXcoord2 <- function(x, root, parent, child, len, start=0, rev=FALSE) {
764 764
         direction <- -1
765 765
     }
766 766
 
767
-    while(anyNA(x)) {
768
-        idx <- which(parent %in% currentNode)
769
-        newNode <- child[idx]
770
-        x[newNode] <- x[parent[idx]]+len[idx] * direction * sign(len[idx])
771
-        currentNode <- newNode
767
+    if (any(len < 0) && (is.null(getOption("ignore.negative.edge")) || !getOption("ignore.negative.edge"))){
768
+        warning_wrap("The tree contained negative ", 
769
+                  ifelse(sum(len < 0)>1, "edge lengths", "edge length"),
770
+                  ". If you want to ignore the ", 
771
+                  ifelse(sum(len<0) > 1, "edges", "edge"),
772
+                  "you can set 'options(ignore.negative.edge=TRUE)', then re-run ggtree."
773
+        )
772 774
     }
773 775
 
776
+    if (getOption("ignore.negative.edge", default=FALSE)){
777
+        while(anyNA(x)) {
778
+            idx <- which(parent %in% currentNode)
779
+            newNode <- child[idx]
780
+            x[newNode] <- x[parent[idx]]+len[idx] * direction * sign(len[idx])
781
+            currentNode <- newNode
782
+        }
783
+    }else{
784
+        while(anyNA(x)) {
785
+            idx <- which(parent %in% currentNode)
786
+            newNode <- child[idx]
787
+            x[newNode] <- x[parent[idx]]+len[idx] * direction
788
+            currentNode <- newNode
789
+        }        
790
+    }
791
+    
774 792
     return(x)
775 793
 }
776 794
 
Browse code

fix issue of negative edge.length

xiangpin authored on 29/09/2021 06:38:31
Showing1 changed files
... ...
@@ -767,7 +767,7 @@ getXcoord2 <- function(x, root, parent, child, len, start=0, rev=FALSE) {
767 767
     while(anyNA(x)) {
768 768
         idx <- which(parent %in% currentNode)
769 769
         newNode <- child[idx]
770
-        x[newNode] <- x[parent[idx]]+len[idx] * direction
770
+        x[newNode] <- x[parent[idx]]+len[idx] * direction * sign(len[idx])
771 771
         currentNode <- newNode
772 772
     }
773 773
 
Browse code

branch.x and branch.y for branch label of unrooted layout

xiangpin authored on 11/06/2021 08:26:23
Showing1 changed files
... ...
@@ -1152,12 +1152,19 @@ add_angle_slanted <- function(res) {
1152 1152
 }
1153 1153
 
1154 1154
 
1155
-calculate_branch_mid <- function(res) {
1155
+calculate_branch_mid <- function(res, layout) {
1156
+    if (layout %in% c("equal_angle", "daylight", "ape")){
1157
+        res$branch.y <- with(res, (y[match(parent, node)] + y)/2)
1158
+        res$branch.y[is.na(res$branch.y)] <- 0
1159
+    }
1156 1160
     res$branch <- with(res, (x[match(parent, node)] + x)/2)
1157 1161
     if (!is.null(res[['branch.length']])) {
1158 1162
         res$branch.length[is.na(res$branch.length)] <- 0
1159 1163
     }
1160 1164
     res$branch[is.na(res$branch)] <- 0
1165
+    if (layout %in% c("equal_angle", "daylight", "ape")){
1166
+        res$branch.x <- res$branch
1167
+    }
1161 1168
     return(res)
1162 1169
 }
1163 1170
 
Browse code

fix ape layout branch.length

xiangpin authored on 25/05/2021 02:18:11
Showing1 changed files
... ...
@@ -1200,7 +1200,7 @@ layoutApe <- function(model, branch.length="branch.length") {
1200 1200
 
1201 1201
 	df <- as_tibble(model) %>%
1202 1202
 		mutate(isTip = ! .data$node %in% .data$parent)
1203
-	df$branch.length <- edge.length[df$node] # for cladogram
1203
+	#df$branch.length <- edge.length[df$node] # for cladogram
1204 1204
 
1205 1205
 	# unrooted layout from cran/ape
1206 1206
 	M <- ape::unrooted.xy(Ntip(tree),
Browse code

not stealing dplyr:::mutate.data.frame()

Romain Francois authored on 04/05/2021 15:14:52
Showing1 changed files
... ...
@@ -46,7 +46,7 @@ layoutEqualAngle <- function(model, branch.length = "branch.length"){
46 46
           tree$edge.length <- NULL
47 47
       }
48 48
   }
49
-  
49
+
50 50
   if (is.null(tree$edge.length) || branch.length == "none") {
51 51
       tree <- set_branch_length_cladogram(tree)
52 52
   }
... ...
@@ -149,7 +149,7 @@ layoutEqualAngle <- function(model, branch.length = "branch.length"){
149 149
 ##' ```
150 150
 layoutDaylight <- function(model, branch.length, MAX_COUNT=5 ){
151 151
 	tree <- as.phylo(model)
152
-	
152
+
153 153
     ## How to set optimal
154 154
     MINIMUM_AVERAGE_ANGLE_CHANGE <- 0.05
155 155
 
... ...
@@ -454,7 +454,7 @@ rotateTreePoints.df <- function(df, pivot_node, nodes, angle){
454 454
   pivot_y = df$y[pivot_node]
455 455
   delta_x = df$x - pivot_x
456 456
   delta_y = df$y - pivot_y
457
-  df = mutate.data.frame(df,
457
+  df = mutate(df,
458 458
     x = ifelse(.data$node %in% nodes, cospitheta * delta_x - sinpitheta * delta_y + pivot_x, .data$x),
459 459
     y = ifelse(.data$node %in% nodes, sinpitheta * delta_x + cospitheta * delta_y + pivot_y, .data$y)
460 460
   )
... ...
@@ -464,7 +464,7 @@ rotateTreePoints.df <- function(df, pivot_node, nodes, angle){
464 464
   # angle is in range [0, 360]
465 465
   # Update label angle of tipnode if not root node.
466 466
   nodes = nodes[! nodes %in% df$parent]
467
-  df %>% mutate.data.frame(
467
+  df %>% mutate(
468 468
     angle = ifelse(.data$node %in% nodes,
469 469
        getNodeAngle.vector(x_parent, y_parent, .data$x, .data$y) %>%
470 470
          {180 * ifelse(. < 0, 2 + ., .)},
... ...
@@ -631,14 +631,6 @@ getRoot.df <- function(df, node){
631 631
   return(root)
632 632
 }
633 633
 
634
-
635
-
636
-mutate.data.frame <- getFromNamespace("mutate.data.frame", "dplyr")
637
-
638
-
639
-
640
-
641
-
642 634
 ##' Get the nodes of tree from root in breadth-first order.
643 635
 ##'
644 636
 ##' @title getNodesBreadthFirst.df
... ...
@@ -896,7 +888,7 @@ getYcoord <- function(tr, step=1, tip.order = NULL) {
896 888
         y[tip.idx] <- match(tr$tip.label, tip.order) * step
897 889
     }
898 890
     y[-tip.idx] <- NA
899
-    
891
+
900 892
 
901 893
     ## use lookup table
902 894
     pvec <- integer(max(tr$edge))
... ...
@@ -1190,26 +1182,26 @@ re_assign_ycoord_df <- function(df, currentNode) {
1190 1182
 
1191 1183
 layoutApe <- function(model, branch.length="branch.length") {
1192 1184
 	tree <- as.phylo(model) %>% stats::reorder("postorder")
1193
-	
1185
+
1194 1186
 	if (! is.null(tree$edge.length)) {
1195 1187
 		if (anyNA(tree$edge.length)) {
1196 1188
 			warning("'edge.length' contains NA values...\n## setting 'edge.length' to NULL automatically when plotting the tree...")
1197 1189
 			tree$edge.length <- NULL
1198 1190
 		}
1199 1191
 	}
1200
-	
1192
+
1201 1193
 	if (is.null(tree$edge.length) || branch.length == "none") {
1202 1194
 		tree <- set_branch_length_cladogram(tree)
1203 1195
 	}
1204
-	
1196
+
1205 1197
 	edge <- tree$edge
1206 1198
 	edge.length <- tree$edge.length
1207 1199
 	nb.sp <- ape::node.depth(tree)
1208
-	
1200
+
1209 1201
 	df <- as_tibble(model) %>%
1210 1202
 		mutate(isTip = ! .data$node %in% .data$parent)
1211 1203
 	df$branch.length <- edge.length[df$node] # for cladogram
1212
-	
1204
+
1213 1205
 	# unrooted layout from cran/ape
1214 1206
 	M <- ape::unrooted.xy(Ntip(tree),
1215 1207
 						  Nnode(tree),
... ...
@@ -1219,13 +1211,13 @@ layoutApe <- function(model, branch.length="branch.length") {
1219 1211
 						  0)$M
1220 1212
 	xx <- M[, 1]
1221 1213
 	yy <- M[, 2]
1222
-	
1214
+
1223 1215
 	M <- tibble::tibble(
1224 1216
 		node = 1:(Ntip(tree) + Nnode(tree)),
1225 1217
 		x = xx - min(xx),
1226 1218
 		y = yy - min(yy)
1227 1219
 	)
1228
-	
1220
+
1229 1221
 	tree_df <- dplyr::full_join(df, M, by = "node") %>%
1230 1222
 		as_tibble()
1231 1223
 	class(tree_df) <- c("tbl_tree", class(tree_df))
Browse code

bug fixed

Guangchuang Yu authored on 13/05/2020 10:20:21
Showing1 changed files
... ...
@@ -1124,7 +1124,8 @@ getYcoord_scale_category <- function(tr, df, yscale, yscale_mapping=NULL, ...) {
1124 1124
         yy <- df[[yscale]]
1125 1125
         ii <- which(is.na(yy))
1126 1126
         if (length(ii)) {
1127
-            df[ii, yscale] <- df[ii, "node"]
1127
+            ## df[ii, yscale] <- df[ii, "node"]
1128
+            df[[yscale]][ii] <- as.character(df[['node']][ii])
1128 1129
         }
1129 1130
     }
1130 1131
 
Browse code

parent method

Guangchuang Yu authored on 13/04/2020 09:10:50
Showing1 changed files
... ...
@@ -610,7 +610,7 @@ getSubtreeUnrooted.df <- function(df, node){
610 610
 
611 611
   # The remaining nodes that are not found in the child subtrees are the remaining subtree nodes.
612 612
   # ie, parent node and all other nodes. We don't care how they are connected, just their id.
613
-  parent_id <- parent(df, node)$node
613
+  parent_id <- parent.tbl_tree(df, node)$node
614 614
   # If node is not root.
615 615
   if ((length(parent_id) > 0) & (length(remaining_nodes) > 0)) {
616 616
     subtrees = tibble::add_row(subtrees, node = parent_id, subtree = list(remaining_nodes))
Browse code

child #287

Guangchuang Yu authored on 13/04/2020 08:50:46
Showing1 changed files
... ...
@@ -598,7 +598,7 @@ getSubtreeUnrooted <- function(tree, node){
598 598
 getSubtreeUnrooted.df <- function(df, node){
599 599
   # get subtree for each child node.
600 600
                                         # children_ids <- getChild.df(df, node)
601
-    children_ids <- tidytree::child(df, node)$node
601
+    children_ids <- child.tbl_tree(df, node)$node
602 602
   if (length(children_ids) == 0L) return(NULL)
603 603
   # if node leaf, return nothing.
604 604
 
Browse code

bug fixed of layoutEqualAngle

Guangchuang Yu authored on 09/04/2020 02:07:12
Showing1 changed files
... ...
@@ -37,7 +37,7 @@ set_branch_length_cladogram <- function(tree) {
37 37
 ##' @param model tree object, e.g. phylo or treedata
38 38
 ##' @param branch.length set to 'none' for edge length of 1. Otherwise the phylogenetic tree edge length is used.
39 39
 ##' @return tree as data.frame with equal angle layout.
40
-layoutEqualAngle <- function(model, branch.length ){
40
+layoutEqualAngle <- function(model, branch.length = "branch.length"){
41 41
 	tree <- as.phylo(model)
42 42
 
43 43
   if (! is.null(tree$edge.length)) {
... ...
@@ -50,10 +50,11 @@ layoutEqualAngle <- function(model, branch.length ){
50 50
   if (is.null(tree$edge.length) || branch.length == "none") {
51 51
       tree <- set_branch_length_cladogram(tree)
52 52
   }
53
-  brlen <- numeric(getNodeNum(tree))
53
+  N <- treeio::Nnode2(tree)
54
+  brlen <- numeric(N)
54 55
   brlen[tree$edge[,2]] <- tree$edge.length
55 56
 
56
-  root <- getRoot(tree)
57
+  root <- tidytree::rootnode(tree)
57 58
   ## Convert Phylo tree to data.frame.
58 59
   ## df <- as.data.frame.phylo_(tree)
59 60
   df <- as_tibble(model) %>%
... ...
@@ -62,11 +63,11 @@ layoutEqualAngle <- function(model, branch.length ){
62 63
     ## NOTE: Angles (start, end, angle) are in half-rotation units (radians/pi or degrees/180)
63 64
 
64 65
     ## create and assign NA to the following fields.
65
-    df$x <- NA
66
-    df$y <- NA
67
-    df$start <- NA # Start angle of segment of subtree.
68
-    df$end   <- NA # End angle of segment of subtree
69
-    df$angle <- NA # Orthogonal angle to beta for tip labels.
66
+    df$x <- 0
67
+    df$y <- 0
68
+    df$start <- 0 # Start angle of segment of subtree.
69
+    df$end   <- 0 # End angle of segment of subtree
70
+    df$angle <- 0 # Orthogonal angle to beta for tip labels.
70 71
     ## Initialize root node position and angles.
71 72
     df[root, "x"] <- 0
72 73
     df[root, "y"] <- 0
... ...
@@ -77,12 +78,10 @@ layoutEqualAngle <- function(model, branch.length ){
77 78
     df$branch.length <- brlen[df$node] # for cladogram
78 79
 
79 80
 
80
-    N <- getNodeNum(tree)
81
-
82 81
     ## Get number of tips for each node in tree.
83 82
   ## nb.sp <- sapply(1:N, function(i) length(get.offspring.tip(tree, i)))
84 83
   ## self_include = TRUE to return itself if the input node is a tip
85
-  nb.sp <- sapply(1:N, function(i) length(offspring(tree, i, tiponly = TRUE, self_include = TRUE)))
84
+  nb.sp <- vapply(1:N, function(i) length(offspring(tree, i, tiponly = TRUE, self_include = TRUE)), numeric(1))
86 85
     ## Get list of node id's.
87 86
     nodes <- getNodes_by_postorder(tree)
88 87
 
... ...
@@ -1220,7 +1219,7 @@ layoutApe <- function(model, branch.length="branch.length") {
1220 1219
 	xx <- M[, 1]
1221 1220
 	yy <- M[, 2]
1222 1221
 	
1223
-	M <- tibble::data_frame(
1222
+	M <- tibble::tibble(
1224 1223
 		node = 1:(Ntip(tree) + Nnode(tree)),
1225 1224
 		x = xx - min(xx),
1226 1225
 		y = yy - min(yy)
Browse code

remove mutate_

Guangchuang Yu authored on 25/03/2020 03:58:15
Showing1 changed files
... ...
@@ -57,7 +57,7 @@ layoutEqualAngle <- function(model, branch.length ){
57 57
   ## Convert Phylo tree to data.frame.
58 58
   ## df <- as.data.frame.phylo_(tree)
59 59
   df <- as_tibble(model) %>%
60
-      mutate_(isTip = ~(! node %in% parent))
60
+      mutate(isTip = ! .data$node %in% .data$parent)
61 61
 
62 62
     ## NOTE: Angles (start, end, angle) are in half-rotation units (radians/pi or degrees/180)
63 63
 
... ...
@@ -1207,7 +1207,7 @@ layoutApe <- function(model, branch.length="branch.length") {
1207 1207
 	nb.sp <- ape::node.depth(tree)
1208 1208
 	
1209 1209
 	df <- as_tibble(model) %>%
1210
-		mutate_(isTip = ~(! node %in% parent))
1210
+		mutate(isTip = ! .data$node %in% .data$parent)
1211 1211
 	df$branch.length <- edge.length[df$node] # for cladogram
1212 1212
 	
1213 1213
 	# unrooted layout from cran/ape
Browse code

bug fixed, #282

Guangchuang Yu authored on 16/03/2020 06:27:18
Showing1 changed files
... ...
@@ -455,7 +455,7 @@ rotateTreePoints.df <- function(df, pivot_node, nodes, angle){
455 455
   pivot_y = df$y[pivot_node]
456 456
   delta_x = df$x - pivot_x
457 457
   delta_y = df$y - pivot_y
458
-  df = dplyr::mutate(df,
458
+  df = mutate.data.frame(df,
459 459
     x = ifelse(.data$node %in% nodes, cospitheta * delta_x - sinpitheta * delta_y + pivot_x, .data$x),
460 460
     y = ifelse(.data$node %in% nodes, sinpitheta * delta_x + cospitheta * delta_y + pivot_y, .data$y)
461 461
   )
... ...
@@ -465,7 +465,7 @@ rotateTreePoints.df <- function(df, pivot_node, nodes, angle){
465 465
   # angle is in range [0, 360]
466 466
   # Update label angle of tipnode if not root node.
467 467
   nodes = nodes[! nodes %in% df$parent]
468
-  df %>% dplyr::mutate(
468
+  df %>% mutate.data.frame(
469 469
     angle = ifelse(.data$node %in% nodes,
470 470
        getNodeAngle.vector(x_parent, y_parent, .data$x, .data$y) %>%
471 471
          {180 * ifelse(. < 0, 2 + ., .)},
... ...
@@ -634,9 +634,7 @@ getRoot.df <- function(df, node){
634 634
 
635 635
 
636 636
 
637
-
638
-
639
-
637
+mutate.data.frame <- getFromNamespace("mutate.data.frame", "dplyr")
640 638
 
641 639
 
642 640
 
Browse code

bug fixed

Guangchuang Yu authored on 26/01/2020 15:25:32
Showing1 changed files
... ...
@@ -1189,8 +1189,9 @@ re_assign_ycoord_df <- function(df, currentNode) {
1189 1189
     return(df)
1190 1190
 }
1191 1191
 
1192
+
1192 1193
 layoutApe <- function(model, branch.length="branch.length") {
1193
-	tree <- as.phylo(model) %>% reorder("postorder")
1194
+	tree <- as.phylo(model) %>% stats::reorder("postorder")
1194 1195
 	
1195 1196
 	if (! is.null(tree$edge.length)) {
1196 1197
 		if (anyNA(tree$edge.length)) {
Browse code

Replaced ape::unrooted.xy code with function call

brj1 authored on 24/01/2020 19:04:21
Showing1 changed files
... ...
@@ -1192,38 +1192,39 @@ re_assign_ycoord_df <- function(df, currentNode) {
1192 1192
 layoutApe <- function(model, branch.length="branch.length") {
1193 1193
 	tree <- as.phylo(model) %>% reorder("postorder")
1194 1194
 	
1195
+	if (! is.null(tree$edge.length)) {
1196
+		if (anyNA(tree$edge.length)) {
1197
+			warning("'edge.length' contains NA values...\n## setting 'edge.length' to NULL automatically when plotting the tree...")
1198
+			tree$edge.length <- NULL
1199
+		}
1200
+	}
1201
+	
1202
+	if (is.null(tree$edge.length) || branch.length == "none") {
1203
+		tree <- set_branch_length_cladogram(tree)
1204
+	}
1205
+	
1195 1206
 	edge <- tree$edge
1196 1207
 	edge.length <- tree$edge.length
1197 1208
 	nb.sp <- ape::node.depth(tree)
1198 1209
 	
1199 1210
 	df <- as_tibble(model) %>%
1200 1211
 		mutate_(isTip = ~(! node %in% parent))
1212
+	df$branch.length <- edge.length[df$node] # for cladogram
1213
+	
1214
+	# unrooted layout from cran/ape
1215
+	M <- ape::unrooted.xy(Ntip(tree),
1216
+						  Nnode(tree),
1217
+						  tree$edge,
1218
+						  tree$edge.length,
1219
+						  nb.sp,
1220
+						  0)$M
1221
+	xx <- M[, 1]
1222
+	yy <- M[, 2]
1201 1223
 	
1202
-	# from ape
1203
-	foo <- function(node, ANGLE, AXIS) {
1204
-		ind <- which(edge[, 1] == node)
1205
-		sons <- edge[ind, 2]
1206
-		start <- AXIS - ANGLE/2
1207
-		for (i in 1:length(sons)) {
1208
-			h <- edge.length[ind[i]]
1209
-			angle[sons[i]] <<- alpha <- ANGLE * nb.sp[sons[i]]/nb.sp[node]
1210
-			axis[sons[i]] <<- beta <- start + alpha/2
1211
-			start <- start + alpha
1212
-			xx[sons[i]] <<- h * cos(beta) + xx[node]
1213
-			yy[sons[i]] <<- h * sin(beta) + yy[node]
1214
-		}
1215
-		for (i in sons) if (i > Ntip(tree)) 
1216
-			foo(i, angle[i], axis[i])
1217
-	}
1218
-	Nedge <- dim(edge)[1]
1219
-	yy <- xx <- numeric(Ntip(tree) + Nnode(tree))
1220
-	axis <- angle <- numeric(Ntip(tree) + Nnode(tree))
1221
-	foo(Ntip(tree) + 1L, 2 * pi, 0)
1222 1224
 	M <- tibble::data_frame(
1223 1225
 		node = 1:(Ntip(tree) + Nnode(tree)),
1224 1226
 		x = xx - min(xx),
1225
-		y = yy - min(yy),
1226
-		angle = angle
1227
+		y = yy - min(yy)
1227 1228
 	)
1228 1229
 	
1229 1230
 	tree_df <- dplyr::full_join(df, M, by = "node") %>%
Browse code

added new layout 'ape' which is a copy of the 'unrooted' type in ape::plot.phylo

brj1 authored on 24/01/2020 03:03:49
Showing1 changed files
... ...
@@ -5,7 +5,8 @@ layout.unrooted <- function(model, branch.length="branch.length", layout.method=
5 5
 
6 6
     df <- switch(layout.method,
7 7
                  equal_angle = layoutEqualAngle(model, branch.length),
8
-                 daylight = layoutDaylight(model, branch.length, MAX_COUNT)
8
+                 daylight = layoutDaylight(model, branch.length, MAX_COUNT),
9
+    			 ape = layoutApe(model, branch.length)
9 10
                  )
10 11
 
11 12
     return(df)
... ...
@@ -1188,3 +1189,45 @@ re_assign_ycoord_df <- function(df, currentNode) {
1188 1189
     return(df)
1189 1190
 }
1190 1191
 
1192
+layoutApe <- function(model, branch.length="branch.length") {
1193
+	tree <- as.phylo(model) %>% reorder("postorder")
1194
+	
1195
+	edge <- tree$edge
1196
+	edge.length <- tree$edge.length
1197
+	nb.sp <- ape::node.depth(tree)
1198
+	
1199
+	df <- as_tibble(model) %>%
1200
+		mutate_(isTip = ~(! node %in% parent))
1201
+	
1202
+	# from ape
1203
+	foo <- function(node, ANGLE, AXIS) {
1204
+		ind <- which(edge[, 1] == node)
1205
+		sons <- edge[ind, 2]
1206
+		start <- AXIS - ANGLE/2
1207
+		for (i in 1:length(sons)) {
1208
+			h <- edge.length[ind[i]]
1209
+			angle[sons[i]] <<- alpha <- ANGLE * nb.sp[sons[i]]/nb.sp[node]
1210
+			axis[sons[i]] <<- beta <- start + alpha/2
1211
+			start <- start + alpha
1212
+			xx[sons[i]] <<- h * cos(beta) + xx[node]
1213
+			yy[sons[i]] <<- h * sin(beta) + yy[node]
1214
+		}
1215
+		for (i in sons) if (i > Ntip(tree)) 
1216
+			foo(i, angle[i], axis[i])
1217
+	}
1218
+	Nedge <- dim(edge)[1]
1219
+	yy <- xx <- numeric(Ntip(tree) + Nnode(tree))
1220
+	axis <- angle <- numeric(Ntip(tree) + Nnode(tree))
1221
+	foo(Ntip(tree) + 1L, 2 * pi, 0)
1222
+	M <- tibble::data_frame(
1223
+		node = 1:(Ntip(tree) + Nnode(tree)),
1224
+		x = xx - min(xx),
1225
+		y = yy - min(yy),
1226
+		angle = angle
1227
+	)
1228
+	
1229
+	tree_df <- dplyr::full_join(df, M, by = "node") %>%
1230
+		as_tibble()
1231
+	class(tree_df) <- c("tbl_tree", class(tree_df))
1232
+	tree_df
1233
+}
Browse code

roxygen2md

Guangchuang Yu authored on 01/11/2019 04:24:00
Showing1 changed files
... ...
@@ -290,13 +290,13 @@ applyLayoutDaylight <- function(df, node_id){
290 290
 
291 291
 
292 292
 ##' Find the right (clockwise rotation, angle from +ve x-axis to furthest subtree nodes) and
293
-##' left (anti-clockwise angle from +ve x-axis to subtree) Returning arc angle in [0, 2] (0 to 360) domain.
293
+##' left (anti-clockwise angle from +ve x-axis to subtree) Returning arc angle in `[0, 2]` (0 to 360) domain.
294 294
 ##'
295 295
 ##' @title getTreeArcAngles
296 296
 ##' @param df tree data.frame
297 297
 ##' @param origin_id node id from which to calculate left and right hand angles of subtree.
298 298
 ##' @param subtree named list of root id of subtree (node) and list of node ids for given subtree (subtree).
299
-##' @return named list with right and left angles in range [0,2] i.e 1 = 180 degrees, 1.5 = 270 degrees.
299
+##' @return named list with right and left angles in range `[0,2]` i.e 1 = 180 degrees, 1.5 = 270 degrees.
300 300
 getTreeArcAngles <- function(df, origin_id, subtree) {
301 301
     df_x = df$x
302 302
     df_y = df$y
... ...
@@ -437,11 +437,12 @@ getTreeArcAngles <- function(df, origin_id, subtree) {
437 437
 
438 438
 ##' Rotate the points in a tree data.frame around a pivot node by the angle specified.
439 439
 ##'
440
-##' @title rotateTreePoints.data.fram
440
+##' @title rotateTreePoints.data.frame
441
+##' @rdname rotateTreePoints
441 442
 ##' @param df tree data.frame
442 443
 ##' @param pivot_node is the id of the pivot node.
443 444
 ##' @param nodes list of node numbers that are to be rotated by angle around the pivot_node
444
-##' @param angle in range [0,2], ie degrees/180, radians/pi
445
+##' @param angle in range `[0,2]`, ie degrees/180, radians/pi
445 446
 ##' @return updated tree data.frame with points rotated by angle
446 447
 rotateTreePoints.df <- function(df, pivot_node, nodes, angle){
447 448
   # Rotate nodes around pivot_node.
... ...
@@ -477,7 +478,7 @@ rotateTreePoints.df <- function(df, pivot_node, nodes, angle){
477 478
 ##' @param df tree data.frame
478 479
 ##' @param origin_node_id origin node id number
479 480
 ##' @param node_id end node id number
480
-##' @return angle in range [-1, 1], i.e. degrees/180, radians/pi
481
+##' @return angle in range `[-1, 1]`, i.e. degrees/180, radians/pi
481 482
 getNodeAngle.df <- function(df, origin_node_id, node_id){
482 483
   if (origin_node_id != node_id) {
483 484
     df_x = df$x
Browse code

ggdensitree

Guangchuang Yu authored on 11/09/2019 01:39:19
Showing1 changed files
... ...
@@ -876,7 +876,7 @@ getXcoord <- function(tr) {
876 876
 
877 877
 ## @importFrom magrittr %>%
878 878
 ##' @importFrom magrittr equals
879
-getYcoord <- function(tr, step=1) {
879
+getYcoord <- function(tr, step=1, tip.order = NULL) {
880 880
     Ntip <- length(tr[["tip.label"]])
881 881
     N <- getNodeNum(tr)
882 882
 
... ...
@@ -889,9 +889,15 @@ getYcoord <- function(tr, step=1) {
889 889
     child_list[as.numeric(names(cl))] <- cl
890 890
 
891 891
     y <- numeric(N)
892
-    tip.idx <- child[child <= Ntip]
893
-    y[tip.idx] <- 1:Ntip * step
892
+    if (is.null(tip.order)) {
893
+        tip.idx <- child[child <= Ntip]
894
+        y[tip.idx] <- 1:Ntip * step
895
+    } else {
896
+        tip.idx <- 1:Ntip
897
+        y[tip.idx] <- match(tr$tip.label, tip.order) * step
898
+    }
894 899
     y[-tip.idx] <- NA
900
+    
895 901
 
896 902
     ## use lookup table
897 903
     pvec <- integer(max(tr$edge))
Browse code

use offspring.tbl_tree

xiangpin authored on 08/09/2019 01:18:55
Showing1 changed files
... ...
@@ -538,7 +538,8 @@ getSubtree.df <- function(df, node){
538 538
   ##   i <- i + 1
539 539
   ## }
540 540
     ## subtree
541
-    tidytree:::offspring.tbl_tree(df, node, self_include = TRUE)$node
541
+    #tidytree:::offspring.tbl_tree(df, node, self_include = TRUE)$node
542
+    offspring.tbl_tree(df, node, self_include = TRUE)$node
542 543
 }
543 544
 
544 545
 ##' Get all subtrees of specified node. This includes all ancestors and relatives of node and
Browse code

geom_cladelabel now supports unrooted tree

Guangchuang Yu authored on 13/08/2019 16:09:40
Showing1 changed files
... ...
@@ -309,7 +309,7 @@ getTreeArcAngles <- function(df, origin_id, subtree) {
309 309
     ## Initialise angle from origin node to parent node.
310 310
     ## If subtree_root_id is child of origin_id
311 311
     ## if (subtree_root_id %in% getChild.df(df, origin_id)) {
312
-    if (subtree_root_id %in% tidytree::child(df, origin_id)$node) {
312
+    if (subtree_root_id %in% tidytree:::child.tbl_tree(df, origin_id)$node) {
313 313
         ## get angle from original node to parent of subtree.
314 314
         theta_left <- getNodeAngle.vector(x_origin, y_origin, df_x[subtree_root_id], df_y[subtree_root_id])
315 315
         theta_right <- theta_left
... ...
@@ -317,7 +317,7 @@ getTreeArcAngles <- function(df, origin_id, subtree) {
317 317
         ## Special case.
318 318
         ## get angle from parent of subtree to children
319 319
         ## children_ids <- getChild.df(df, subtree_root_id)
320
-        children_ids <- tidytree::child(df, subtree_root_id)$node
320
+        children_ids <- tidytree:::child.tbl_tree(df, subtree_root_id)$node
321 321
         if(length(children_ids) == 2){
322 322
             ## get angles from parent to it's two children.
323 323
             theta1 <- getNodeAngle.vector(x_origin, y_origin, df_x[children_ids[1]], df_y[children_ids[1]])
... ...
@@ -372,7 +372,7 @@ getTreeArcAngles <- function(df, origin_id, subtree) {
372 372
     # Get angle from origin node to parent node.
373 373
     theta_parent <- getNodeAngle.vector(x_origin, y_origin, df_x[parent_id], df_y[parent_id])
374 374
       ## children_ids <- getChild.df(df, parent_id)
375
-      children_ids <- tidytree::child(df, parent_id)$node
375
+      children_ids <- tidytree:::child.tbl_tree(df, parent_id)$node
376 376
     # Skip if child is parent node of subtree.
377 377
     children_ids = children_ids[children_ids != origin_id]
378 378
     for(child_id in children_ids){
Browse code

upgrade nodeid and define nodelab methods

Guangchuang Yu authored on 09/08/2019 03:15:25
Showing1 changed files
... ...
@@ -678,38 +678,6 @@ getNodesBreadthFirst.df <- function(df){
678 678
 }
679 679
 
680 680
 
681
-
682
-##' convert tip or node label(s) to internal node number
683
-##'
684
-##'
685
-##' @title nodeid
686
-##' @param x tree object or graphic object return by ggtree
687
-##' @param label tip or node label(s)
688
-##' @return internal node number
689
-##' @importFrom methods is
690
-##' @export
691
-##' @author Guangchuang Yu
692
-nodeid <- function(x, label) {
693
-    if (is(x, "gg"))
694
-        return(nodeid.gg(x, label))
695
-
696
-    nodeid.tree(x, label)
697
-}
698
-
699
-nodeid.tree <- function(tree, label) {
700
-    tr <- get.tree(tree)
701
-    lab <- c(tr$tip.label, tr$node.label)
702
-    match(label, lab)
703
-}
704
-
705
-nodeid.gg <- function(p, label) {
706
-    p$data$node[match(label, p$data$label)]
707
-}
708
-
709
-
710
-
711
-
712
-
713 681
 isRoot <- function(tr, node) {
714 682
     getRoot(tr) == node
715 683
 }
Browse code

geom_range

Guangchuang Yu authored on 23/07/2019 16:25:05
Showing1 changed files
... ...
@@ -357,11 +357,11 @@ getTreeArcAngles <- function(df, origin_id, subtree) {
357 357
   # no parent angle found.
358 358
   # Subtree has to have 1 or more nodes to compare.
359 359
   if (is.na(theta_left) || (length(subtree_node_ids) == 0)){
360
-    return(0)
360
+      return(c('left' = 0, 'right' = 0))
361 361
   }
362 362
   # create vector with named columns
363 363
   # left-hand and right-hand angles between origin node and the extremities of the tree nodes.
364
-  arc <- c('left' = theta_left, 'right' = theta_right)
364
+    arc <- c('left' = theta_left, 'right' = theta_right)
365 365
 
366 366
   # Calculate the angle from the origin node to each child node.
367 367
   # Moving from parent to children in depth-first traversal.
Browse code

clean up code

Guangchuang Yu authored on 30/01/2019 12:53:00
Showing1 changed files
... ...
@@ -80,7 +80,8 @@ layoutEqualAngle <- function(model, branch.length ){
80 80
 
81 81
     ## Get number of tips for each node in tree.
82 82
   ## nb.sp <- sapply(1:N, function(i) length(get.offspring.tip(tree, i)))
83
-  nb.sp <- sapply(1:N, function(i) length(offspring(tree, i, tiponly = TRUE)))
83
+  ## self_include = TRUE to return itself if the input node is a tip
84
+  nb.sp <- sapply(1:N, function(i) length(offspring(tree, i, tiponly = TRUE, self_include = TRUE)))
84 85
     ## Get list of node id's.
85 86
     nodes <- getNodes_by_postorder(tree)
86 87
 
... ...
@@ -88,7 +89,8 @@ layoutEqualAngle <- function(model, branch.length ){
88 89
         ## Get number of tips for current node.
89 90
         curNtip <- nb.sp[curNode]
90 91
         ## Get array of child node indexes of current node.
91
-        children <- getChild(tree, curNode)
92
+        ## children <- getChild(tree, curNode)
93
+        children <- treeio::child(tree, curNode)
92 94
 
93 95
         ## Get "start" and "end" angles of a segment for current node in the data.frame.
94 96
         start <- df[curNode, "start"]
... ...
@@ -120,7 +122,9 @@ layoutEqualAngle <- function(model, branch.length ){
120 122
             start <- start + alpha
121 123
         }
122 124
     }
123
-    df
125
+  tree_df <- as_tibble(df)
126
+  class(tree_df) <- c("tbl_tree", class(tree_df))
127
+  return(tree_df)
124 128
 }
125 129
 
126 130
 ##' Equal daylight layout method for unrooted trees.
... ...
@@ -182,8 +186,9 @@ layoutDaylight <- function(model, branch.length, MAX_COUNT=5 ){
182 186
         if (ave_change <= MINIMUM_AVERAGE_ANGLE_CHANGE) break
183 187
     }
184 188
 
185
-    return(tree_df)
186
-
189
+  tree_df <- as_tibble(tree_df)
190
+  class(tree_df) <- c("tbl_tree", class(tree_df))
191
+  return(tree_df)
187 192
 }
188 193
 
189 194
 ##' Apply the daylight alorithm to adjust the spacing between the subtrees and tips of the
... ...
@@ -303,14 +308,16 @@ getTreeArcAngles <- function(df, origin_id, subtree) {
303 308
     subtree_node_ids <- subtree$subtree
304 309
     ## Initialise angle from origin node to parent node.
305 310
     ## If subtree_root_id is child of origin_id
306
-    if (subtree_root_id %in% getChild.df(df, origin_id)) {
311
+    ## if (subtree_root_id %in% getChild.df(df, origin_id)) {
312
+    if (subtree_root_id %in% tidytree::child(df, origin_id)$node) {
307 313
         ## get angle from original node to parent of subtree.
308 314
         theta_left <- getNodeAngle.vector(x_origin, y_origin, df_x[subtree_root_id], df_y[subtree_root_id])
309 315
         theta_right <- theta_left
310 316
     } else if( subtree_root_id == origin_id ){
311 317
         ## Special case.
312 318
         ## get angle from parent of subtree to children
313
-        children_ids <- getChild.df(df, subtree_root_id)
319
+        ## children_ids <- getChild.df(df, subtree_root_id)
320
+        children_ids <- tidytree::child(df, subtree_root_id)$node
314 321
         if(length(children_ids) == 2){
315 322
             ## get angles from parent to it's two children.
316 323
             theta1 <- getNodeAngle.vector(x_origin, y_origin, df_x[children_ids[1]], df_y[children_ids[1]])
... ...
@@ -364,7 +371,8 @@ getTreeArcAngles <- function(df, origin_id, subtree) {
364 371
   for(parent_id in subtree_node_ids){
365 372
     # Get angle from origin node to parent node.
366 373
     theta_parent <- getNodeAngle.vector(x_origin, y_origin, df_x[parent_id], df_y[parent_id])
367
-    children_ids <- getChild.df(df, parent_id)
374
+      ## children_ids <- getChild.df(df, parent_id)
375
+      children_ids <- tidytree::child(df, parent_id)$node
368 376
     # Skip if child is parent node of subtree.
369 377
     children_ids = children_ids[children_ids != origin_id]
370 378
     for(child_id in children_ids){
... ...
@@ -503,15 +511,16 @@ getNodeEuclDistances <- function(df, node){
503 511
 ##' @return list of all child node id's from starting node.
504 512
 getSubtree <- function(tree, node){
505 513
 
506
-  subtree <- c(node)
507
-  i <- 1
508
-  while( i <= length(subtree)){
509
-    subtree <- c(subtree, getChild(tree, subtree[i]))
510
-    # remove any '0' root nodes
511
-    subtree <- subtree[subtree != 0]
512
-    i <- i + 1
513
-  }
514
-  return(subtree)
514
+  ## subtree <- c(node)
515
+  ## i <- 1
516
+  ## while( i <= length(subtree)){
517
+  ##   subtree <- c(subtree, treeio::child(tree, subtree[i]))
518
+  ##   # remove any '0' root nodes
519
+  ##   subtree <- subtree[subtree != 0]
520
+  ##   i <- i + 1
521
+  ## }
522
+    ## return(subtree)
523
+    tidytree::offspring(tree, node, self_include = TRUE)
515 524
 }
516 525
 
517 526
 ##' Get all children of node from df tree using breath-first.
... ...
@@ -521,13 +530,15 @@ getSubtree <- function(tree, node){
521 530
 ##' @param node id of starting node.
522 531
 ##' @return list of all child node id's from starting node.
523 532
 getSubtree.df <- function(df, node){
524
-  subtree <- node[node != 0]
525
-  i <- 1
526
-  while( i <= length(subtree)){
527
-    subtree <- c(subtree, getChild.df(df, subtree[i]))
528
-    i <- i + 1
529
-  }
530
-  subtree
533
+  ## subtree <- node[node != 0]
534
+  ## i <- 1
535
+  ## while( i <= length(subtree)){
536
+  ##     ## subtree <- c(subtree, getChild.df(df, subtree[i]))
537
+  ##     subtree <- c(subtree, tidytree::child(df, subtree[i])$node)
538
+  ##   i <- i + 1
539
+  ## }
540
+    ## subtree
541
+    tidytree:::offspring.tbl_tree(df, node, self_include = TRUE)$node
531 542
 }
532 543
 
533 544
 ##' Get all subtrees of specified node. This includes all ancestors and relatives of node and
... ...
@@ -539,7 +550,7 @@ getSubtree.df <- function(df, node){
539 550
 ##' @return named list of subtrees with the root id of subtree and list of node id's making up subtree.
540 551
 getSubtreeUnrooted <- function(tree, node){
541 552
   # if node leaf, return nothing.
542
-  if( isTip(tree, node) ){
553
+  if( treeio::isTip(tree, node) ){
543 554
     # return NA
544 555
     return(NA)
545 556
   }
... ...
@@ -547,7 +558,8 @@ getSubtreeUnrooted <- function(tree, node){
547 558
   subtrees <- list()
548 559
 
549 560
   # get subtree for each child node.
550
-  children_ids <- getChild(tree, node)
561
+    ## children_ids <- getChild(tree, node)
562
+    children_ids <- treeio::child(tree, node)
551 563
 
552 564
   remaining_nodes <- getNodes_by_postorder(tree)
553 565
   # Remove current node from remaining_nodes list.
... ...
@@ -564,7 +576,7 @@ getSubtreeUnrooted <- function(tree, node){
564 576
 
565 577
   # The remaining nodes that are not found in the child subtrees are the remaining subtree nodes.
566 578
   # ie, parent node and all other nodes. We don't care how they are connect, just their ids.
567
-  parent_id <- getParent(tree, node)
579
+  parent_id <- parent(tree, node)
568 580
   # If node is not root, add remainder of tree nodes as subtree.
569 581
   if( parent_id != 0 & length(remaining_nodes) >= 1){
570 582
     subtrees[[length(subtrees)+1]] <- list( node = parent_id, subtree = remaining_nodes)
... ...
@@ -579,10 +591,12 @@ getSubtreeUnrooted <- function(tree, node){
579 591
 ##' @title getSubtreeUnrooted
580 592
 ##' @param df tree data.frame
581 593
 ##' @param node is the tree node id from which the subtrees are derived.
594
+##' @importFrom tidytree parent
582 595
 ##' @return named list of subtrees with the root id of subtree and list of node id's making up subtree.
583 596
 getSubtreeUnrooted.df <- function(df, node){
584 597
   # get subtree for each child node.
585
-  children_ids <- getChild.df(df, node)
598
+                                        # children_ids <- getChild.df(df, node)
599
+    children_ids <- tidytree::child(df, node)$node
586 600
   if (length(children_ids) == 0L) return(NULL)
587 601
   # if node leaf, return nothing.
588 602
 
... ...
@@ -594,7 +608,7 @@ getSubtreeUnrooted.df <- function(df, node){
594 608
 
595 609
   # The remaining nodes that are not found in the child subtrees are the remaining subtree nodes.
596 610
   # ie, parent node and all other nodes. We don't care how they are connected, just their id.
597
-  parent_id <- getParent.df(df, node)
611
+  parent_id <- parent(df, node)$node
598 612
   # If node is not root.
599 613
   if ((length(parent_id) > 0) & (length(remaining_nodes) > 0)) {
600 614
     subtrees = tibble::add_row(subtrees, node = parent_id, subtree = list(remaining_nodes))
... ...
@@ -622,19 +636,6 @@ getRoot.df <- function(df, node){
622 636
 
623 637
 
624 638
 
625
-isTip <- function(tr, node) {
626
-  children_ids <- getChild(tr, node)
627
-  #length(children_ids) == 0 ## getChild returns 0 if nothing found.
628
-  return( length(children_ids) == 0 | any(children_ids == 0) )
629
-}
630
-
631
-isTip.df <- function(df, node) {
632
-  # df may not have the isTip structure.
633
-  # return(df[node, 'isTip'])
634
-  # Tip has no children.
635
-  children_ids <- getChild.df(df, node)
636
-  length(children_ids) == 0
637
-}
638 639
 
639 640
 
640 641
 
... ...
@@ -646,7 +647,7 @@ isTip.df <- function(df, node) {
646 647
 getNodesBreadthFirst.df <- function(df){
647 648
 
648 649
   root <- getRoot.df(df)
649
-  if(isTip.df(df, root)){
650
+  if(treeio::isTip(df, root)){
650 651
     return(root)
651 652
   }
652 653
 
... ...
@@ -660,12 +661,12 @@ getNodesBreadthFirst.df <- function(df){
660 661
     i <- i + 1
661 662
 
662 663
     # Skip if parent is a tip.
663
-    if(isTip.df(df, parent)){
664
+    if(treeio::isTip(df, parent)){
664 665
       next
665 666
     }
666 667
 
667 668
     # get children of current parent.
668
-    children <- getChild.df(df,parent)
669
+    children <- tidytree::child(df,parent)$node
669 670
 
670 671
     # add children to result
671 672
     res <- c(res, children)
... ...
@@ -708,137 +709,6 @@ nodeid.gg <- function(p, label) {
708 709
 
709 710
 
710 711
 
711
-##' Get parent node id of child node.
712
-##'
713
-##' @title getParent.df
714
-##' @param df tree data.frame
715
-##' @param node is the node id of child in tree.
716
-##' @return integer node id of parent
717
-getParent.df <- function(df, node) {
718
-    parent_id <- df$parent[df$node == node]
719
-    parent_id[parent_id != node]
720
-}
721
-
722
-
723
-getAncestor.df <- function(df, node) {
724
-    anc <- getParent.df(df, node)
725
-    i <- 1
726
-    while(i<= length(anc)) {
727
-        anc <- c(anc, getParent.df(df, anc[i]))
728
-        i <- i+1
729
-    }
730
-    return(anc)
731
-}
732
-
733
-
734
-
735
-##' Get list of child node id numbers of parent node
736
-##'
737
-##' @title getChild.df
738
-##' @param df tree data.frame
739
-##' @param node is the node id of child in tree.
740
-##' @return list of child node ids of parent
741
-getChild.df <- function(df, node) {
742
-    res <- df$node[df$parent == node]
743
-    res[res != node] ## node may root
744
-}
745
-
746
-## get.offspring.df <- function(df, node) {
747
-##     ## sp <- getChild.df(df, node)
748
-##     ## i <- 1
749
-##     ## while(i <= length(sp)) {
750
-##     ##     sp <- c(sp, getChild.df(df, sp[i]))
751
-##     ##     i <- i + 1
752
-##     ## }
753
-##     ## return(sp)
754
-##     tidytree::offspring(df, node)$node
755
-## }
756
-
757
-
758
-
759
-## ##' extract offspring tips
760
-## ##'
761
-## ##'
762
-## ##' @title get.offspring.tip
763
-## ##' @param tr tree
764
-## ##' @param node node
765
-## ##' @return tip label
766
-## ##' @author ygc
767
-## ##' @importFrom ape extract.clade
768
-## ##' @export
769
-## get.offspring.tip <- function(tr, node) {
770
-##     ## if ( ! node %in% tr$edge[,1]) {
771
-##     ##     ## return itself
772
-##     ##     return(tr$tip.label[node])
773
-##     ## }
774
-##     ## clade <- extract.clade(tr, node)
775
-##     ## clade$tip.label
776
-##     tid <- offspring(tr, node, tiponly = TRUE)
777
-##     tr$tip.label[tid]
778
-## }
779
-
780
-
781
-
782
-
783
-getParent <- function(tr, node) {
784
-    if ( node == getRoot(tr) )
785
-        return(0)
786
-    edge <- tr[["edge"]]
787
-    parent <- edge[,1]
788
-    child <- edge[,2]
789
-    res <- parent[child == node]
790
-    if (length(res) == 0) {
791
-        stop("cannot found parent node...")
792
-    }
793
-    if (length(res) > 1) {
794
-        stop("multiple parent found...")
795
-    }
796
-    return(res)
797
-}
798
-
799
-
800
-
801
-
802
-getChild <- function(tr, node) {
803
-    # Get edge matrix from phylo object.
804
-    edge <- tr[["edge"]]
805
-    # Select all rows that match "node".
806
-    res <- edge[edge[,1] == node, 2]
807
-    ## if (length(res) == 0) {
808
-    ##     ## is a tip
809
-    ##     return(NA)
810
-    ## }
811
-    return(res)
812
-}
813
-
814
-
815
-getSibling <- function(tr, node) {
816
-    root <- getRoot(tr)
817
-    if (node == root) {
818
-        return(NA)
819
-    }
820
-
821
-    parent <- getParent(tr, node)
822
-    child <- getChild(tr, parent)
823
-    sib <- child[child != node]
824
-    return(sib)
825
-}
826
-
827
-
828
-getAncestor <- function(tr, node) {
829
-    root <- getRoot(tr)
830
-    if (node == root) {
831
-        return(NA)
832
-    }
833
-    parent <- getParent(tr, node)
834
-    res <- parent
835
-    while(parent != root) {
836
-        parent <- getParent(tr, parent)
837
-        res <- c(res, parent)
838
-    }
839
-    return(res)
840
-}
841
-
842 712
 
843 713
 isRoot <- function(tr, node) {
844 714
     getRoot(tr) == node
... ...
@@ -874,12 +744,13 @@ get.trunk <- function(tr) {
874 744
 ##' @param from start node
875 745
 ##' @param to end node
876 746
 ##' @return node vectot
747
+##' @importFrom tidytree ancestor
877 748
 ##' @export
878 749
 ##' @author Guangchuang Yu
879 750
 get.path <- function(phylo, from, to) {
880
-    anc_from <- getAncestor(phylo, from)
751
+    anc_from <- ancestor(phylo, from)
881 752
     anc_from <- c(from, anc_from)
882
-    anc_to <- getAncestor(phylo, to)
753
+    anc_to <- ancestor(phylo, to)
883 754
     anc_to <- c(to, anc_to)
884 755
     mrca <- intersect(anc_from, anc_to)[1]
885 756
 
... ...
@@ -1132,7 +1003,7 @@ getYcoord_scale2 <- function(tr, df, yscale) {
1132 1003
     ii <- 1
1133 1004
     ntip <- length(ordered_tip)
1134 1005
     while(ii < ntip) {
1135
-        sib <- getSibling(tr, ordered_tip[ii])
1006
+        sib <- tidytree::sibling(tr, ordered_tip[ii])
1136 1007
         if (length(sib) == 0) {
1137 1008
             ii <- ii + 1
1138 1009
             next
... ...
@@ -1155,7 +1026,7 @@ getYcoord_scale2 <- function(tr, df, yscale) {
1155 1026
     }
1156 1027
 
1157 1028
 
1158
-    long_branch <- getAncestor(tr, ordered_tip[1]) %>% rev
1029
+    long_branch <- ancestor(tr, ordered_tip[1]) %>% rev
1159 1030
     long_branch <- c(long_branch, ordered_tip[1])
1160 1031
 
1161 1032
     N <- getNodeNum(tr)
... ...
@@ -1223,7 +1094,7 @@ getYcoord_scale_numeric <- function(tr, df, yscale, ...) {
1223 1094
         tree <- get.tree(tr)
1224 1095
         nodes <- getNodes_by_postorder(tree)
1225 1096
         for (curNode in nodes) {
1226
-            children <- getChild(tree, curNode)
1097
+            children <- treeio::child(tree, curNode)
1227 1098
             if (length(children) == 0) {
1228 1099
                 next
1229 1100
             }
... ...
@@ -1249,13 +1120,13 @@ getYcoord_scale_numeric <- function(tr, df, yscale, ...) {
1249 1120
         tree <- get.tree(tr)
1250 1121
         nodes <- rev(getNodes_by_postorder(tree))
1251 1122
         for (curNode in nodes) {
1252
-            parent <- getParent(tree, curNode)
1123
+            parent <- parent(tree, curNode)
1253 1124
             if (parent == 0) { ## already reach root
1254 1125
                 next
1255 1126
             }
1256 1127
             idx <- which(is.na(yy[parent]))
1257 1128
             if (length(idx) > 0) {
1258
-                child <- getChild(tree, parent)
1129
+                child <- treeio::child(tree, parent)
1259 1130
                 yy[parent[idx]] <- mean(yy[child], na.rm=TRUE)
1260 1131
             }
1261 1132
         }
Browse code

remove get.offspring.df & get.offspring.tip

Guangchuang Yu authored on 28/01/2019 09:12:15
Showing1 changed files
... ...
@@ -79,7 +79,8 @@ layoutEqualAngle <- function(model, branch.length ){
79 79
     N <- getNodeNum(tree)
80 80
 
81 81
     ## Get number of tips for each node in tree.
82
-    nb.sp <- sapply(1:N, function(i) length(get.offspring.tip(tree, i)))
82
+  ## nb.sp <- sapply(1:N, function(i) length(get.offspring.tip(tree, i)))
83
+  nb.sp <- sapply(1:N, function(i) length(offspring(tree, i, tiponly = TRUE)))
83 84
     ## Get list of node id's.
84 85
     nodes <- getNodes_by_postorder(tree)
85 86
 
... ...
@@ -742,36 +743,39 @@ getChild.df <- function(df, node) {
742 743
     res[res != node] ## node may root
743 744
 }
744 745
 
745
-get.offspring.df <- function(df, node) {
746
-    sp <- getChild.df(df, node)
747
-    i <- 1
748
-    while(i <= length(sp)) {
749
-        sp <- c(sp, getChild.df(df, sp[i]))
750
-        i <- i + 1
751
-    }
752
-    return(sp)
753
-}
746
+## get.offspring.df <- function(df, node) {
747
+##     ## sp <- getChild.df(df, node)
748
+##     ## i <- 1
749
+##     ## while(i <= length(sp)) {
750
+##     ##     sp <- c(sp, getChild.df(df, sp[i]))
751
+##     ##     i <- i + 1
752
+##     ## }
753
+##     ## return(sp)
754
+##     tidytree::offspring(df, node)$node
755
+## }
754 756
 
755 757
 
756 758
 
757
-##' extract offspring tips
758
-##'
759
-##'
760
-##' @title get.offspring.tip
761
-##' @param tr tree
762
-##' @param node node
763
-##' @return tip label
764
-##' @author ygc
765
-##' @importFrom ape extract.clade
766
-##' @export
767
-get.offspring.tip <- function(tr, node) {
768
-    if ( ! node %in% tr$edge[,1]) {
769
-        ## return itself
770
-        return(tr$tip.label[node])
771
-    }
772
-    clade <- extract.clade(tr, node)
773
-    clade$tip.label
774
-}
759
+## ##' extract offspring tips
760
+## ##'
761
+## ##'
762
+## ##' @title get.offspring.tip
763
+## ##' @param tr tree
764
+## ##' @param node node
765
+## ##' @return tip label
766
+## ##' @author ygc
767
+## ##' @importFrom ape extract.clade
768
+## ##' @export
769
+## get.offspring.tip <- function(tr, node) {
770
+##     ## if ( ! node %in% tr$edge[,1]) {
771
+##     ##     ## return itself
772
+##     ##     return(tr$tip.label[node])
773
+##     ## }
774
+##     ## clade <- extract.clade(tr, node)
775
+##     ## clade$tip.label
776
+##     tid <- offspring(tr, node, tiponly = TRUE)
777
+##     tr$tip.label[tid]
778
+## }
775 779
 
776 780
 
777 781
 
Browse code

mv reroot to treeio

Guangchuang Yu authored on 28/12/2018 09:34:31
Showing1 changed files
... ...
@@ -705,38 +705,6 @@ nodeid.gg <- function(p, label) {
705 705
 }
706 706
 
707 707
 
708
-reroot_node_mapping <- function(tree, tree2) {
709
-    root <- getRoot(tree)
710
-
711
-    node_map <- data.frame(from=1:getNodeNum(tree), to=NA, visited=FALSE)
712
-    node_map[1:Ntip(tree), 2] <- match(tree$tip.label, tree2$tip.label)
713
-    node_map[1:Ntip(tree), 3] <- TRUE
714
-
715
-    node_map[root, 2] <- root
716
-    node_map[root, 3] <- TRUE
717
-
718
-    node <- rev(tree$edge[,2])
719
-    for (k in node) {
720
-        ip <- getParent(tree, k)
721
-        if (node_map[ip, "visited"])
722
-            next
723
-
724
-        cc <- getChild(tree, ip)
725
-        node2 <- node_map[cc,2]
726
-        if (anyNA(node2)) {
727
-            node <- c(node, k)
728
-            next
729
-        }
730
-
731
-        to <- unique(sapply(node2, getParent, tr=tree2))
732
-        to <- to[! to %in% node_map[,2]]
733
-        node_map[ip, 2] <- to
734
-        node_map[ip, 3] <- TRUE
735
-    }
736
-    node_map <- node_map[, -3]
737
-    return(node_map)
738
-}
739
-
740 708
 
741 709
 
742 710
 ##' Get parent node id of child node.
Browse code

bug fixed

Guangchuang Yu authored on 26/12/2018 10:10:58
Showing1 changed files
... ...
@@ -46,10 +46,12 @@ layoutEqualAngle <- function(model, branch.length ){
46 46
       }
47 47
   }
48 48
   
49
-  if (branch.length == "none") {
49
+  if (is.null(tree$edge.length) || branch.length == "none") {
50 50
       tree <- set_branch_length_cladogram(tree)
51 51
   }
52
-  
52
+  brlen <- numeric(getNodeNum(tree))
53
+  brlen[tree$edge[,2]] <- tree$edge.length
54
+
53 55
   root <- getRoot(tree)
54 56
   ## Convert Phylo tree to data.frame.
55 57
   ## df <- as.data.frame.phylo_(tree)
... ...
@@ -71,6 +73,9 @@ layoutEqualAngle <- function(model, branch.length ){
71 73
     df[root, "end"]   <- 2 # 360-degrees
72 74
     df[root, "angle"] <- 0 # Angle label.
73 75
 
76
+    df$branch.length <- brlen[df$node] # for cladogram
77
+
78
+
74 79
     N <- getNodeNum(tree)
75 80
 
76 81
     ## Get number of tips for each node in tree.
Browse code

compatible with tibble 2.0.0

Guangchuang Yu authored on 29/11/2018 15:42:00
Showing1 changed files
... ...
@@ -53,7 +53,7 @@ layoutEqualAngle <- function(model, branch.length ){
53 53
   root <- getRoot(tree)
54 54
   ## Convert Phylo tree to data.frame.
55 55
   ## df <- as.data.frame.phylo_(tree)
56
-  df <- as_data_frame(model) %>%
56
+  df <- as_tibble(model) %>%
57 57
       mutate_(isTip = ~(! node %in% parent))
58 58
 
59 59
     ## NOTE: Angles (start, end, angle) are in half-rotation units (radians/pi or degrees/180)
... ...
@@ -672,13 +672,6 @@ getNodesBreadthFirst.df <- function(df){
672 672
 
673 673
 
674 674
 
675
-
676
-
677
-
678
-
679
-
680
-
681
-
682 675
 ##' convert tip or node label(s) to internal node number
683 676
 ##'
684 677
 ##'
Browse code

added MAX_COUNT to layoutDaylight documenation

brj1 authored on 20/11/2018 20:32:24
Showing1 changed files
... ...
@@ -122,6 +122,7 @@ layoutEqualAngle <- function(model, branch.length ){
122 122
 ##' #' @title
123 123
 ##' @param model tree object, e.g. phylo or treedata
124 124
 ##' @param branch.length set to 'none' for edge length of 1. Otherwise the phylogenetic tree edge length is used.
125
+##' @param MAX_COUNT the maximum number of iterations to run (default 5)
125 126
 ##' @return tree as data.frame with equal angle layout.
126 127
 ##' @references
127 128
 ##' The following aglorithm aims to implement the vague description of the "Equal-daylight Algorithm"
Browse code

made MAX_COUNT in layoutDaylight parameterized

brj1 authored on 14/11/2018 22:25:01
Showing1 changed files
... ...
@@ -1,11 +1,11 @@
1 1
 
2 2
 
3 3
 ##' @importFrom ape reorder.phylo
4
-layout.unrooted <- function(model, branch.length="branch.length", layout.method="equal_angle", ...) {
4
+layout.unrooted <- function(model, branch.length="branch.length", layout.method="equal_angle", MAX_COUNT=5, ...) {
5 5
 
6 6
     df <- switch(layout.method,
7 7
                  equal_angle = layoutEqualAngle(model, branch.length),
8
-                 daylight = layoutDaylight(model, branch.length)
8
+                 daylight = layoutDaylight(model, branch.length, MAX_COUNT)
9 9
                  )
10 10
 
11 11
     return(df)
... ...
@@ -136,11 +136,10 @@ layoutEqualAngle <- function(model, branch.length ){
136 136
 ##' nodes = remove tip nodes.
137 137
 ##'
138 138
 ##' ```
139
-layoutDaylight <- function(model, branch.length ){
139
+layoutDaylight <- function(model, branch.length, MAX_COUNT=5 ){
140 140
 	tree <- as.phylo(model)
141 141
 	
142 142
     ## How to set optimal
143
-    MAX_COUNT <- 5
144 143
     MINIMUM_AVERAGE_ANGLE_CHANGE <- 0.05
145 144
 
146 145
 
Browse code

update docs

Guangchuang Yu authored on 11/10/2018 02:44:13
Showing1 changed files
... ...
@@ -7,7 +7,7 @@ layout.unrooted <- function(model, branch.length="branch.length", layout.method=
7 7
                  equal_angle = layoutEqualAngle(model, branch.length),
8 8
                  daylight = layoutDaylight(model, branch.length)
9 9
                  )
10
-    
10
+
11 11
     return(df)
12 12
 }
13 13
 
... ...
@@ -33,21 +33,28 @@ set_branch_length_cladogram <- function(tree) {
33 33
 ##' "Inferring Phylogenies" by Joseph Felsenstein.
34 34
 ##'
35 35
 ##' @title layoutEqualAngle
36
-##' @param tree phylo object
36
+##' @param model tree object, e.g. phylo or treedata
37 37
 ##' @param branch.length set to 'none' for edge length of 1. Otherwise the phylogenetic tree edge length is used.
38 38
 ##' @return tree as data.frame with equal angle layout.
39 39
 layoutEqualAngle <- function(model, branch.length ){
40 40
 	tree <- as.phylo(model)
41
-	
42
-    if (branch.length == "none") {
43
-        tree <- set_branch_length_cladogram(tree)
44
-    }
45 41
 
46
-    root <- getRoot(tree)
47
-    ## Convert Phylo tree to data.frame.
48
-    ## df <- as.data.frame.phylo_(tree)
49
-    df <- as_data_frame(model) %>%
50
-        mutate_(isTip = ~(! node %in% parent))
42
+  if (! is.null(tree$edge.length)) {
43
+      if (anyNA(tree$edge.length)) {
44
+          warning("'edge.length' contains NA values...\n## setting 'edge.length' to NULL automatically when plotting the tree...")
45
+          tree$edge.length <- NULL
46
+      }
47
+  }
48
+  
49
+  if (branch.length == "none") {
50
+      tree <- set_branch_length_cladogram(tree)
51
+  }
52
+  
53
+  root <- getRoot(tree)
54
+  ## Convert Phylo tree to data.frame.
55
+  ## df <- as.data.frame.phylo_(tree)
56
+  df <- as_data_frame(model) %>%
57
+      mutate_(isTip = ~(! node %in% parent))
51 58
 
52 59
     ## NOTE: Angles (start, end, angle) are in half-rotation units (radians/pi or degrees/180)
53 60
 
... ...
@@ -113,7 +120,7 @@ layoutEqualAngle <- function(model, branch.length ){
113 120
 ##' Equal daylight layout method for unrooted trees.
114 121
 ##'
115 122
 ##' #' @title
116
-##' @param tree phylo object
123
+##' @param model tree object, e.g. phylo or treedata
117 124
 ##' @param branch.length set to 'none' for edge length of 1. Otherwise the phylogenetic tree edge length is used.
118 125
 ##' @return tree as data.frame with equal angle layout.
119 126
 ##' @references
Browse code

Merge branch 'master' of github.com:GuangchuangYu/ggtree

Guangchuang Yu authored on 11/10/2018 02:19:14
Showing0 changed files
Browse code

update

Guangchuang Yu authored on 11/10/2018 02:19:08
Showing1 changed files
... ...
@@ -7,7 +7,7 @@ layout.unrooted <- function(tree, branch.length="branch.length", layout.method="
7 7
                  equal_angle = layoutEqualAngle(tree, branch.length),
8 8
                  daylight = layoutDaylight(tree, branch.length)
9 9
                  )
10
-
10
+    
11 11
     return(df)
12 12
 }
13 13
 
Browse code

made data usable with treedata in 'equal_angle' and 'daylight' layouts

brj1 authored on 10/10/2018 23:33:37
Showing1 changed files
... ...
@@ -1,11 +1,11 @@
1 1
 
2 2
 
3 3
 ##' @importFrom ape reorder.phylo
4
-layout.unrooted <- function(tree, branch.length="branch.length", layout.method="equal_angle", ...) {
4
+layout.unrooted <- function(model, branch.length="branch.length", layout.method="equal_angle", ...) {
5 5
 
6 6
     df <- switch(layout.method,
7
-                 equal_angle = layoutEqualAngle(tree, branch.length),
8
-                 daylight = layoutDaylight(tree, branch.length)
7
+                 equal_angle = layoutEqualAngle(model, branch.length),
8
+                 daylight = layoutDaylight(model, branch.length)
9 9
                  )
10 10
 
11 11
     return(df)
... ...
@@ -36,7 +36,9 @@ set_branch_length_cladogram <- function(tree) {
36 36
 ##' @param tree phylo object
37 37
 ##' @param branch.length set to 'none' for edge length of 1. Otherwise the phylogenetic tree edge length is used.
38 38
 ##' @return tree as data.frame with equal angle layout.
39
-layoutEqualAngle <- function(tree, branch.length ){
39
+layoutEqualAngle <- function(model, branch.length ){
40
+	tree <- as.phylo(model)
41
+	
40 42
     if (branch.length == "none") {
41 43
         tree <- set_branch_length_cladogram(tree)
42 44
     }
... ...
@@ -44,7 +46,7 @@ layoutEqualAngle <- function(tree, branch.length ){
44 46
     root <- getRoot(tree)
45 47
     ## Convert Phylo tree to data.frame.
46 48
     ## df <- as.data.frame.phylo_(tree)
47
-    df <- as_data_frame(tree) %>%
49
+    df <- as_data_frame(model) %>%
48 50
         mutate_(isTip = ~(! node %in% parent))
49 51