git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@128515 bc3139a8-67e5-0310-9ffc-ced21a209358
... | ... |
@@ -6,8 +6,7 @@ Version: 1.7.10 |
6 | 6 |
Authors@R: c( |
7 | 7 |
person("Guangchuang", "Yu", email = "guangchuangyu@gmail.com", role = c("aut", "cre", "cph")), |
8 | 8 |
person("Tommy Tsan-Yuk", "Lam", email = "tylam.tommy@gmail.com", rol = c("aut", "ths")), |
9 |
- person("Justin", "Silverman", email = "jsilve24@gmail.com", rol = "ctb"), |
|
10 |
- person("Hugo", "Gruson", email = "hugo.gruson@normalesup.org", rol = "ctb") |
|
9 |
+ person("Justin", "Silverman", email = "jsilve24@gmail.com", rol = "ctb") |
|
11 | 10 |
) |
12 | 11 |
Maintainer: Guangchuang Yu <guangchuangyu@gmail.com> |
13 | 12 |
Description: 'ggtree' extends the 'ggplot2' plotting system which implemented |
... | ... |
@@ -5,6 +5,7 @@ |
5 | 5 |
##' @param tr phylo object |
6 | 6 |
##' @param mapping aes mapping |
7 | 7 |
##' @param layout one of 'rectangular', 'slanted', 'fan', 'circular', 'radial' or 'unrooted' |
8 |
+##' @param layout.method of 'equal_angle', 'daylight'. |
|
8 | 9 |
##' @param open.angle open angle, only for 'fan' layout |
9 | 10 |
##' @param mrsd most recent sampling date |
10 | 11 |
##' @param as.Date logical whether using Date class in time tree |
... | ... |
@@ -33,6 +34,7 @@ |
33 | 34 |
ggtree <- function(tr, |
34 | 35 |
mapping = NULL, |
35 | 36 |
layout = "rectangular", |
37 |
+ layout.method = "equal_angle", |
|
36 | 38 |
open.angle = 0, |
37 | 39 |
mrsd = NULL, |
38 | 40 |
as.Date = FALSE, |
... | ... |
@@ -44,8 +46,10 @@ ggtree <- function(tr, |
44 | 46 |
ndigits = NULL, |
45 | 47 |
...) { |
46 | 48 |
|
49 |
+ # Check if layout string is valid. |
|
47 | 50 |
layout %<>% match.arg(c("rectangular", "slanted", "fan", "circular", "radial", "unrooted")) |
48 |
- |
|
51 |
+ layout.method %<>% match.arg(c("equal_angle", "daylight")) |
|
52 |
+ |
|
49 | 53 |
if (is(tr, "r8s") && branch.length == "branch.length") { |
50 | 54 |
branch.length = "TREE" |
51 | 55 |
} |
... | ... |
@@ -60,8 +64,11 @@ ggtree <- function(tr, |
60 | 64 |
} else { |
61 | 65 |
mapping <- modifyList(aes_(~x, ~y), mapping) |
62 | 66 |
} |
63 |
- p <- ggplot(tr, mapping=mapping, |
|
67 |
+ |
|
68 |
+ p <- ggplot(tr, |
|
69 |
+ mapping = mapping, |
|
64 | 70 |
layout = layout, |
71 |
+ layout.method = layout.method, |
|
65 | 72 |
mrsd = mrsd, |
66 | 73 |
as.Date = as.Date, |
67 | 74 |
yscale = yscale, |
... | ... |
@@ -110,6 +110,7 @@ rm.singleton.newick <- function(nwk, outfile = NULL) { |
110 | 110 |
##' @export |
111 | 111 |
fortify.beast <- function(model, data, |
112 | 112 |
layout = "rectangular", |
113 |
+ layout.method = "equal_angle", |
|
113 | 114 |
yscale = "none", |
114 | 115 |
ladderize = TRUE, |
115 | 116 |
right = FALSE, |
... | ... |
@@ -119,7 +120,8 @@ fortify.beast <- function(model, data, |
119 | 120 |
|
120 | 121 |
model <- set_branch_length(model, branch.length) |
121 | 122 |
phylo <- model@phylo |
122 |
- df <- fortify(phylo, layout=layout, branch.length=branch.length, |
|
123 |
+ df <- fortify(phylo, layout=layout, layout.method=layout.method, |
|
124 |
+ branch.length=branch.length, |
|
123 | 125 |
ladderize=ladderize, right=right, mrsd = mrsd, ...) |
124 | 126 |
|
125 | 127 |
stats <- model@stats |
... | ... |
@@ -220,6 +222,7 @@ fortify.beast <- function(model, data, |
220 | 222 |
##' @export |
221 | 223 |
fortify.codeml <- function(model, data, |
222 | 224 |
layout = "rectangular", |
225 |
+ layout.method = "equal_angle", |
|
223 | 226 |
yscale = "none", |
224 | 227 |
ladderize = TRUE, |
225 | 228 |
right = FALSE, |
... | ... |
@@ -265,6 +268,7 @@ fortify.codeml <- function(model, data, |
265 | 268 |
##' @export |
266 | 269 |
fortify.codeml_mlc <- function(model, data, |
267 | 270 |
layout = "rectangular", |
271 |
+ layout.method = "equal_angle", |
|
268 | 272 |
yscale = "none", |
269 | 273 |
ladderize = TRUE, |
270 | 274 |
right = FALSE, |
... | ... |
@@ -306,6 +310,7 @@ merge_phylo_anno.codeml_mlc <- function(df, dNdS, ndigits = NULL) { |
306 | 310 |
|
307 | 311 |
fortify.codeml_mlc_ <- function(model, data, |
308 | 312 |
layout = "rectangular", |
313 |
+ layout.method = "equal_angle", |
|
309 | 314 |
ladderize = TRUE, |
310 | 315 |
right = FALSE, |
311 | 316 |
branch.length = "branch.length", |
... | ... |
@@ -317,8 +322,12 @@ fortify.codeml_mlc_ <- function(model, data, |
317 | 322 |
|
318 | 323 |
##' @method fortify paml_rst |
319 | 324 |
##' @export |
320 |
-fortify.paml_rst <- function(model, data, layout = "rectangular", yscale="none", |
|
321 |
- ladderize=TRUE, right=FALSE, mrsd=NULL, ...) { |
|
325 |
+fortify.paml_rst <- function(model, data, |
|
326 |
+ layout = "rectangular", |
|
327 |
+ yscale="none", |
|
328 |
+ ladderize=TRUE, |
|
329 |
+ right=FALSE, |
|
330 |
+ mrsd=NULL, ...) { |
|
322 | 331 |
df <- fortify.phylo(model@phylo, data, layout, ladderize, right, mrsd=mrsd, ...) |
323 | 332 |
df <- merge_phylo_anno.paml_rst(df, model) |
324 | 333 |
df <- scaleY(model@phylo, df, yscale, layout, ...) |
... | ... |
@@ -353,8 +362,11 @@ fortify.hyphy <- fortify.paml_rst |
353 | 362 |
##' @importFrom treeio get.placements |
354 | 363 |
##' @export |
355 | 364 |
fortify.jplace <- function(model, data, |
356 |
- layout="rectangular", yscale="none", |
|
357 |
- ladderize=TRUE, right=FALSE, mrsd=NULL, ...) { |
|
365 |
+ layout="rectangular", |
|
366 |
+ yscale="none", |
|
367 |
+ ladderize=TRUE, |
|
368 |
+ right=FALSE, |
|
369 |
+ mrsd=NULL, ...) { |
|
358 | 370 |
df <- extract.treeinfo.jplace(model, layout, ladderize, right, mrsd=mrsd, ...) |
359 | 371 |
place <- get.placements(model, by="best") |
360 | 372 |
|
... | ... |
@@ -403,8 +415,13 @@ fortify.phylo4 <- function(model, data, layout="rectangular", yscale="none", |
403 | 415 |
|
404 | 416 |
##' @method fortify phylo4d |
405 | 417 |
##' @export |
406 |
-fortify.phylo4d <- function(model, data, layout="rectangular", yscale="none", |
|
407 |
- ladderize=TRUE, right=FALSE, branch.length="branch.length", |
|
418 |
+fortify.phylo4d <- function(model, data, |
|
419 |
+ layout="rectangular", |
|
420 |
+ layout.method = "equal_angle", |
|
421 |
+ yscale="none", |
|
422 |
+ ladderize=TRUE, |
|
423 |
+ right=FALSE, |
|
424 |
+ branch.length="branch.length", |
|
408 | 425 |
mrsd=NULL, ...) { |
409 | 426 |
## model <- set_branch_length(model, branch.length) |
410 | 427 |
## phylo <- as.phylo.phylo4(model) |
... | ... |
@@ -413,7 +430,7 @@ fortify.phylo4d <- function(model, data, layout="rectangular", yscale="none", |
413 | 430 |
## tdata <- model@data[match(res$node, rownames(model@data)), , drop=FALSE] |
414 | 431 |
## df <- cbind(res, tdata) |
415 | 432 |
## scaleY(as.phylo.phylo4(model), df, yscale, layout, ...) |
416 |
- fortify(as.treedata(model), data, layout, yscale, ladderize, right, branch.length, mrsd, ...) |
|
433 |
+ fortify(as.treedata(model), data, layout, layout.method, yscale, ladderize, right, branch.length, mrsd, ...) |
|
417 | 434 |
} |
418 | 435 |
|
419 | 436 |
|
... | ... |
@@ -438,8 +455,12 @@ fortify.phylo4d <- function(model, data, layout="rectangular", yscale="none", |
438 | 455 |
##' @method fortify phylo |
439 | 456 |
##' @export |
440 | 457 |
##' @author Yu Guangchuang |
441 |
-fortify.phylo <- function(model, data, layout="rectangular", |
|
442 |
- ladderize=TRUE, right=FALSE, mrsd=NULL, as.Date=FALSE, ...) { |
|
458 |
+fortify.phylo <- function(model, data, |
|
459 |
+ layout="rectangular", |
|
460 |
+ ladderize=TRUE, |
|
461 |
+ right=FALSE, |
|
462 |
+ mrsd=NULL, |
|
463 |
+ as.Date=FALSE, ...) { |
|
443 | 464 |
tree <- reorder.phylo(model, 'postorder') |
444 | 465 |
|
445 | 466 |
if (ladderize == TRUE) { |
... | ... |
@@ -605,18 +626,26 @@ fortify.multiPhylo <- function(model, data, layout="rectangular", |
605 | 626 |
|
606 | 627 |
##' @method fortify phylip |
607 | 628 |
##' @export |
608 |
-fortify.phylip <- function(model, data, layout="rectangular", |
|
609 |
- ladderize=TRUE, right=FALSE, |
|
610 |
- branch.length = "TREE", mrsd=NULL, ...) { |
|
629 |
+fortify.phylip <- function(model, data, |
|
630 |
+ layout="rectangular", |
|
631 |
+ layout.method = "equal_angle", |
|
632 |
+ ladderize=TRUE, |
|
633 |
+ right=FALSE, |
|
634 |
+ branch.length = "TREE", |
|
635 |
+ mrsd=NULL, ...) { |
|
611 | 636 |
trees <- get.tree(model) |
612 | 637 |
fortify(trees, layout=layout, ladderize = ladderize, right=right, mrsd=mrsd, ...) |
613 | 638 |
} |
614 | 639 |
|
615 | 640 |
##' @method fortify r8s |
616 | 641 |
##' @export |
617 |
-fortify.r8s <- function(model, data, layout="rectangular", |
|
618 |
- ladderize=TRUE, right=FALSE, |
|
619 |
- branch.length = "TREE", mrsd=NULL, ...) { |
|
642 |
+fortify.r8s <- function(model, data, |
|
643 |
+ layout="rectangular", |
|
644 |
+ layout.method = "equal_angle", |
|
645 |
+ ladderize=TRUE, |
|
646 |
+ right=FALSE, |
|
647 |
+ branch.length = "TREE", |
|
648 |
+ mrsd=NULL, ...) { |
|
620 | 649 |
trees <- get.tree(model) |
621 | 650 |
branch.length %<>% match.arg(names(trees)) |
622 | 651 |
phylo <- trees[[branch.length]] |
... | ... |
@@ -625,8 +654,11 @@ fortify.r8s <- function(model, data, layout="rectangular", |
625 | 654 |
|
626 | 655 |
##' @method fortify obkData |
627 | 656 |
##' @export |
628 |
-fortify.obkData <- function(model, data, layout="rectangular", |
|
629 |
- ladderize=TRUE, right=FALSE, mrsd = NULL, ...) { |
|
657 |
+fortify.obkData <- function(model, data, |
|
658 |
+ layout="rectangular", |
|
659 |
+ ladderize=TRUE, |
|
660 |
+ right=FALSE, |
|
661 |
+ mrsd = NULL, ...) { |
|
630 | 662 |
|
631 | 663 |
df <- fortify(model@trees[[1]], layout=layout, ladderize=ladderize, right=right, mrsd=mrsd, ...) |
632 | 664 |
|
... | ... |
@@ -644,8 +676,11 @@ fortify.obkData <- function(model, data, layout="rectangular", |
644 | 676 |
|
645 | 677 |
##' @method fortify phyloseq |
646 | 678 |
##' @export |
647 |
-fortify.phyloseq <- function(model, data, layout="rectangular", |
|
648 |
- ladderize=TRUE, right=FALSE, mrsd=NULL, ...) { |
|
679 |
+fortify.phyloseq <- function(model, data, |
|
680 |
+ layout="rectangular", |
|
681 |
+ ladderize=TRUE, |
|
682 |
+ right=FALSE, |
|
683 |
+ mrsd=NULL, ...) { |
|
649 | 684 |
|
650 | 685 |
df <- fortify(model@phy_tree, layout=layout, ladderize=ladderize, right=right, mrsd=mrsd, ...) |
651 | 686 |
phyloseq <- "phyloseq" |
... | ... |
@@ -159,79 +159,624 @@ reroot_node_mapping <- function(tree, tree2) { |
159 | 159 |
|
160 | 160 |
|
161 | 161 |
##' @importFrom ape reorder.phylo |
162 |
-layout.unrooted <- function(tree, branch.length="branch.length", ...) { |
|
163 |
- N <- getNodeNum(tree) |
|
164 |
- root <- getRoot(tree) |
|
162 |
+layout.unrooted <- function(tree, branch.length="branch.length", layout.method="equal.angle", ...) { |
|
165 | 163 |
|
166 |
- df <- as.data.frame.phylo_(tree) |
|
167 |
- df$x <- NA |
|
168 |
- df$y <- NA |
|
169 |
- df$start <- NA |
|
170 |
- df$end <- NA |
|
171 |
- df$angle <- NA |
|
172 |
- df[root, "x"] <- 0 |
|
173 |
- df[root, "y"] <- 0 |
|
174 |
- df[root, "start"] <- 0 |
|
175 |
- df[root, "end"] <- 2 |
|
176 |
- df[root, "angle"] <- 0 |
|
164 |
+ switch(layout.method, |
|
165 |
+ equal_angle = { df <- layoutEqualAngle(tree, branch.length) }, |
|
166 |
+ daylight = { df <- layoutDaylight(tree, branch.length) } |
|
167 |
+ ) |
|
177 | 168 |
|
178 |
- nb.sp <- sapply(1:N, function(i) length(get.offspring.tip(tree, i))) |
|
169 |
+ return(df) |
|
170 |
+} |
|
179 | 171 |
|
180 |
- nodes <- getNodes_by_postorder(tree) |
|
181 | 172 |
|
182 |
- for(curNode in nodes) { |
|
183 |
- curNtip <- nb.sp[curNode] |
|
184 |
- children <- getChild(tree, curNode) |
|
173 |
+##' 'Equal-angle layout algorithm for unrooted trees' |
|
174 |
+##' |
|
175 |
+##' @references |
|
176 |
+##' "Inferring Phylogenies" by Joseph Felsenstein. |
|
177 |
+##' |
|
178 |
+##' @title layoutEqualAngle |
|
179 |
+##' @param tree phylo object |
|
180 |
+##' @param branch.length set to 'none' for edge length of 1. Otherwise the phylogenetic tree edge length is used. |
|
181 |
+##' @return tree as data.frame with equal angle layout. |
|
182 |
+layoutEqualAngle <- function(tree, branch.length ){ |
|
183 |
+ root <- getRoot(tree) |
|
184 |
+ # Convert Phylo tree to data.frame. |
|
185 |
+ df <- as.data.frame.phylo_(tree) |
|
186 |
+ |
|
187 |
+ # NOTE: Angles (start, end, angle) are in half-rotation units (radians/pi or degrees/180) |
|
188 |
+ |
|
189 |
+ # create and assign NA to the following fields. |
|
190 |
+ df$x <- NA |
|
191 |
+ df$y <- NA |
|
192 |
+ df$start <- NA # Start angle of segment of subtree. |
|
193 |
+ df$end <- NA # End angle of segment of subtree |
|
194 |
+ df$angle <- NA # Orthogonal angle to beta ... for labels?? |
|
195 |
+ # Initialize root node position and angles. |
|
196 |
+ df[root, "x"] <- 0 |
|
197 |
+ df[root, "y"] <- 0 |
|
198 |
+ df[root, "start"] <- 0 # 0-degrees |
|
199 |
+ df[root, "end"] <- 2 # 360-degrees |
|
200 |
+ df[root, "angle"] <- 0 # Angle label. |
|
201 |
+ |
|
202 |
+ N <- getNodeNum(tree) |
|
203 |
+ |
|
204 |
+ # Get number of tips for each node in tree. |
|
205 |
+ nb.sp <- sapply(1:N, function(i) length(get.offspring.tip(tree, i))) |
|
206 |
+ # Get list of node id's. |
|
207 |
+ nodes <- getNodes_by_postorder(tree) |
|
208 |
+ |
|
209 |
+ for(curNode in nodes) { |
|
210 |
+ # Get number of tips for current node. |
|
211 |
+ curNtip <- nb.sp[curNode] |
|
212 |
+ # Get array of child node indexes of current node. |
|
213 |
+ children <- getChild(tree, curNode) |
|
214 |
+ |
|
215 |
+ # Get "start" and "end" angles of a segment for current node in the data.frame. |
|
216 |
+ start <- df[curNode, "start"] |
|
217 |
+ end <- df[curNode, "end"] |
|
218 |
+ |
|
219 |
+ if (length(children) == 0) { |
|
220 |
+ ## is a tip |
|
221 |
+ next |
|
222 |
+ } |
|
185 | 223 |
|
186 |
- start <- df[curNode, "start"] |
|
187 |
- end <- df[curNode, "end"] |
|
224 |
+ for (i in seq_along(children)) { |
|
225 |
+ child <- children[i] |
|
226 |
+ # Get the number of tips for child node. |
|
227 |
+ ntip.child <- nb.sp[child] |
|
228 |
+ |
|
229 |
+ # Calculated in half radians. |
|
230 |
+ # alpha: angle of segment for i-th child with ntips_ij tips. |
|
231 |
+ # alpha = (left_angle - right_angle) * (ntips_ij)/(ntips_current) |
|
232 |
+ alpha <- (end - start) * ntip.child / curNtip |
|
233 |
+ # beta = angle of line from parent node to i-th child. |
|
234 |
+ beta <- start + alpha / 2 |
|
235 |
+ |
|
236 |
+ if (branch.length == "none") { |
|
237 |
+ length.child <- 1 |
|
238 |
+ } else { |
|
239 |
+ length.child <- df[child, "length"] |
|
240 |
+ } |
|
241 |
+ |
|
242 |
+ # update geometry of data.frame. |
|
243 |
+ # Calculate (x,y) position of the i-th child node from current node. |
|
244 |
+ df[child, "x"] <- df[curNode, "x"] + cospi(beta) * length.child |
|
245 |
+ df[child, "y"] <- df[curNode, "y"] + sinpi(beta) * length.child |
|
246 |
+ # Calculate orthogonal angle to beta. |
|
247 |
+ df[child, "angle"] <- -90 - 180 * beta * sign(beta - 1) |
|
248 |
+ # Update the start and end angles of the childs segment. |
|
249 |
+ df[child, "start"] <- start |
|
250 |
+ df[child, "end"] <- start + alpha |
|
251 |
+ start <- start + alpha |
|
252 |
+ } |
|
188 | 253 |
|
189 |
- if (length(children) == 0) { |
|
190 |
- ## is a tip |
|
191 |
- next |
|
192 |
- } |
|
254 |
+ } |
|
193 | 255 |
|
194 |
- for (i in seq_along(children)) { |
|
195 |
- child <- children[i] |
|
196 |
- ntip.child <- nb.sp[child] |
|
256 |
+ return(df) |
|
197 | 257 |
|
198 |
- alpha <- (end - start) * ntip.child/curNtip |
|
199 |
- beta <- start + alpha / 2 |
|
258 |
+} |
|
200 | 259 |
|
201 |
- if (branch.length == "none") { |
|
202 |
- length.child <- 1 |
|
203 |
- } else { |
|
204 |
- length.child <- df[child, "length"] |
|
205 |
- } |
|
260 |
+##' Equal daylight layout method for unrooted trees. |
|
261 |
+##' |
|
262 |
+##' #' @title |
|
263 |
+##' @param tree phylo object |
|
264 |
+##' @param branch.length set to 'none' for edge length of 1. Otherwise the phylogenetic tree edge length is used. |
|
265 |
+##' @return tree as data.frame with equal angle layout. |
|
266 |
+##' @references |
|
267 |
+##' The following aglorithm aims to implement the vague description of the "Equal-daylight Algorithm" |
|
268 |
+##' in "Inferring Phylogenies" pp 582-584 by Joseph Felsenstein. |
|
269 |
+##' |
|
270 |
+##' ``` |
|
271 |
+##' Leafs are subtrees with no children |
|
272 |
+##' Initialise tree using equal angle algorithm |
|
273 |
+##' tree_df = equal_angle(tree) |
|
274 |
+##' |
|
275 |
+##' nodes = get list of nodes in tree_df breadth-first |
|
276 |
+##' nodes = remove tip nodes. |
|
277 |
+##' |
|
278 |
+##' ``` |
|
279 |
+layoutDaylight <- function( tree, branch.length ){ |
|
280 |
+ |
|
281 |
+ # How to set optimal |
|
282 |
+ MAX_COUNT <- 100 |
|
283 |
+ MINIMUM_AVERAGE_ANGLE_CHANGE <- 0.01 |
|
284 |
+ |
|
285 |
+ |
|
286 |
+ # Initialize tree. |
|
287 |
+ tree_df <- layoutEqualAngle(tree, branch.length) |
|
288 |
+ |
|
289 |
+ # nodes = get list of nodes in tree_df |
|
290 |
+ # Get list of node id's. |
|
291 |
+ #nodes <- getNodes_by_postorder(tree) |
|
292 |
+ # nodes <- GetSubtree.df(tree_df, root) |
|
293 |
+ |
|
294 |
+ # Get list of internal nodes |
|
295 |
+ #nodes <- tree_df[tree_df$IsTip != TRUE]$nodes |
|
296 |
+ |
|
297 |
+ nodes <- getNodesBreadthFirst.df(tree_df) |
|
298 |
+ # select only internal nodes |
|
299 |
+ internal_nodes <- tree_df[!tree_df$isTip,]$node |
|
300 |
+ # Remove tips from nodes list, but keeping order. |
|
301 |
+ nodes <- intersect(nodes, internal_nodes) |
|
302 |
+ |
|
303 |
+ i <- 1 |
|
304 |
+ ave_change <- 1.0 |
|
305 |
+ while( i <= MAX_COUNT & ave_change > MINIMUM_AVERAGE_ANGLE_CHANGE ){ |
|
306 |
+ cat('Iteration: ', i, '\n') |
|
307 |
+ |
|
308 |
+ # Reset max_change after iterating over tree. |
|
309 |
+ total_max <- 0.0 |
|
310 |
+ |
|
311 |
+ # for node in nodes { |
|
312 |
+ for( j in seq_along(nodes)){ |
|
313 |
+ currentNode_id <- nodes[j] |
|
314 |
+ |
|
315 |
+ result <- applyLayoutDaylight(tree_df, currentNode_id) |
|
316 |
+ tree_df <- result$tree |
|
317 |
+ total_max <- total_max + result$max_change |
|
206 | 318 |
|
207 |
- df[child, "x"] <- df[curNode, "x"] + cospi(beta) * length.child |
|
208 |
- df[child, "y"] <- df[curNode, "y"] + sinpi(beta) * length.child |
|
209 |
- df[child, "angle"] <- -90 -180 * beta * sign(beta - 1) |
|
210 |
- df[child, "start"] <- start |
|
211 |
- df[child, "end"] <- start + alpha |
|
212 |
- start <- start + alpha |
|
319 |
+ } |
|
320 |
+ |
|
321 |
+ ave_change <- total_max / length(nodes) |
|
322 |
+ |
|
323 |
+ cat('Average angle change', ave_change,'\n') |
|
324 |
+ |
|
325 |
+ i <- i + 1 |
|
326 |
+ } |
|
327 |
+ |
|
328 |
+ return(tree_df) |
|
329 |
+ |
|
330 |
+} |
|
331 |
+ |
|
332 |
+##' Apply the daylight alorithm to adjust the spacing between the subtrees and tips of the |
|
333 |
+##' specified node. |
|
334 |
+##' |
|
335 |
+##' @title applyLayoutDaylight |
|
336 |
+##' @param df tree data.frame |
|
337 |
+##' @param node_id is id of the node from which daylight is measured to the other subtrees. |
|
338 |
+##' @return list with tree data.frame with updated layout using daylight algorithm and max_change angle. |
|
339 |
+## |
|
340 |
+## |
|
341 |
+## ``` |
|
342 |
+## for node in nodes { |
|
343 |
+## if node is a leaf { |
|
344 |
+## next |
|
345 |
+## } |
|
346 |
+## |
|
347 |
+## subtrees = get subtrees of node |
|
348 |
+## |
|
349 |
+## for i-th subtree in subtrees { |
|
350 |
+## [end, start] = get left and right angles of tree from node id. |
|
351 |
+## angle_list[i, 'left'] = end |
|
352 |
+## angle_list[i, 'beta'] = start - end # subtree arc angle |
|
353 |
+## angle_list[i, 'index'] = i-th # index of subtree/leaf |
|
354 |
+## } |
|
355 |
+## |
|
356 |
+## sort angle_list by 'left' column in ascending order. |
|
357 |
+## |
|
358 |
+## D = 360 - sum( angle_list['beta'] ) # total daylight angle |
|
359 |
+## d = D / |subtrees| # equal daylight angle. |
|
360 |
+## |
|
361 |
+## new_L = left angle of first subtree. |
|
362 |
+## |
|
363 |
+## for n-th row in angle_list{ |
|
364 |
+## # Calculate angle to rotate subtree/leaf to create correct daylight angle. |
|
365 |
+## new_left_angle = new_left_angle + d + angle_list[n, 'beta'] |
|
366 |
+## Calculate the difference between the old and new left angles. |
|
367 |
+## adjust_angle = new_left_angle - angle_list[n, 'left'] |
|
368 |
+## |
|
369 |
+## index = angle_list['index'] |
|
370 |
+## rotate subtree[index] wrt n-th node by adjust_angle |
|
371 |
+## } |
|
372 |
+## } |
|
373 |
+## } |
|
374 |
+## ``` |
|
375 |
+applyLayoutDaylight <- function(df, node_id ){ |
|
376 |
+ |
|
377 |
+ max_change <- 0.0 |
|
378 |
+ |
|
379 |
+ # Get lists of node ids for each subtree, including rest of unrooted tree. |
|
380 |
+ subtrees <- getSubtreeUnrooted.df(df, node_id) |
|
381 |
+ angle_list <- data.frame(left=numeric(0), beta=numeric(0), subtree_id=integer(0) ) |
|
382 |
+ |
|
383 |
+ # Return tree if only 2 or less subtrees to adjust. |
|
384 |
+ if(length(subtrees) <= 2){ |
|
385 |
+ return( list(tree = df, max_change = max_change) ) |
|
386 |
+ } |
|
387 |
+ |
|
388 |
+ # Find start and end angles for each subtree. |
|
389 |
+ # subtrees = get subtrees of node |
|
390 |
+ # for i-th subtree in subtrees { |
|
391 |
+ for (i in seq_along(subtrees) ) { |
|
392 |
+ subtree <- subtrees[[i]] |
|
393 |
+ # [end, start] = get start and end angles of tree. |
|
394 |
+ |
|
395 |
+ angles <- getTreeArcAngles(df, node_id, subtree) |
|
396 |
+ angle_list[ i, 'subtree_id'] <- i |
|
397 |
+ angle_list[ i, 'left'] <- angles['left'] |
|
398 |
+ angle_list[ i, 'beta'] <- angles['left'] - angles['right'] # subtree arc angle |
|
399 |
+ # If subtree arc angle is -ve, then + 2 (360). |
|
400 |
+ if(angle_list[ i, 'beta'] < 0 ){ |
|
401 |
+ angle_list[ i, 'beta'] <- angle_list[ i, 'beta'] + 2 |
|
402 |
+ } |
|
403 |
+ } |
|
404 |
+ # sort angle_list by 'left angle' column in ascending order. |
|
405 |
+ angle_list <- angle_list[with(angle_list, order(left)), ] |
|
406 |
+ # D = 360 - sum( angle_list['beta'] ) # total day |
|
407 |
+ # d = D / |subtrees| # equal daylight angle. |
|
408 |
+ total_daylight <- 2 - colSums(angle_list['beta']) |
|
409 |
+ d <- total_daylight / length(subtrees) |
|
410 |
+ |
|
411 |
+ # Initialise new left-angle as first subtree left-angle. |
|
412 |
+ new_left_angle <- angle_list[1, 'left'] |
|
413 |
+ |
|
414 |
+ # Adjust angles of subtrees and tips connected to current node. |
|
415 |
+ # for n-th row in angle_list{ |
|
416 |
+ # Skip the first subtree as it is not adjusted. |
|
417 |
+ for (i in 2:nrow(angle_list) ) { |
|
418 |
+ # Calculate angle to rotate subtree/leaf to create correct daylight angle. |
|
419 |
+ new_left_angle <- new_left_angle + d + angle_list[i, 'beta'] |
|
420 |
+ # Calculate the difference between the old and new left angles. |
|
421 |
+ adjust_angle <- new_left_angle - angle_list[i, 'left'] |
|
422 |
+ |
|
423 |
+ max_change <- max(max_change, abs(adjust_angle)) |
|
424 |
+ #cat('Adjust angle:', abs(adjust_angle), ' Max change:', max_change ,'\n') |
|
425 |
+ |
|
426 |
+ # rotate subtree[index] wrt current node |
|
427 |
+ subtree_id <- angle_list[i, 'subtree_id'] |
|
428 |
+ subtree_nodes <- subtrees[[subtree_id]]$subtree |
|
429 |
+ # update tree_df for all subtrees with rotated points. |
|
430 |
+ df <- rotateTreePoints.df(df, node_id, subtree_nodes, adjust_angle) |
|
431 |
+ } |
|
432 |
+ |
|
433 |
+ return( list(tree = df, max_change = max_change) ) |
|
434 |
+ |
|
435 |
+} |
|
436 |
+ |
|
437 |
+ |
|
438 |
+##' Find the right (clockwise rotation, angle from +ve x-axis to furthest subtree nodes) and |
|
439 |
+##' left (anti-clockwise angle from +ve x-axis to subtree) |
|
440 |
+##' |
|
441 |
+##' @title getTreeArcAngles |
|
442 |
+##' @param df tree data.frame |
|
443 |
+##' @param origin_id node id from which to calculate left and right hand angles of subtree. |
|
444 |
+##' @param subtree named list of root id of subtree and list of node ids for given subtree. |
|
445 |
+##' @return named list with right and left angles in range [0,2] i.e 1 = 180 degrees, 1.5 = 270 degrees. |
|
446 |
+getTreeArcAngles <- function(df, origin_id, subtree) { |
|
447 |
+ # Initialise variables |
|
448 |
+ theta_child <- 0.0 |
|
449 |
+ subtree_root_id <- subtree$node |
|
450 |
+ subtree_node_ids <- subtree$subtree |
|
451 |
+ |
|
452 |
+ # Initialise angle from origin node to parent node. |
|
453 |
+ # If subtree_root_id is child of origin_id |
|
454 |
+ if( any(subtree_root_id == getChild.df(df, origin_id)) ){ |
|
455 |
+ theta_parent <- getNodeAngle.df(df, origin_id, subtree_root_id) |
|
456 |
+ }else{ |
|
457 |
+ # get the real root of df tree to initialise left and right angles. |
|
458 |
+ theta_parent <- getNodeAngle.df(df, origin_id, getRoot.df(df)) |
|
459 |
+ } |
|
460 |
+ |
|
461 |
+ # create vector with named columns |
|
462 |
+ # left-hand and right-hand angles between origin node and the extremities of the tree nodes. |
|
463 |
+ arc <- c('left' = theta_parent, 'right' = theta_parent) |
|
464 |
+ |
|
465 |
+ # Subtree has to have 1 or more nodes to compare. |
|
466 |
+ if (length(subtree_node_ids) == 0 ){ |
|
467 |
+ return(0) |
|
468 |
+ } |
|
469 |
+ |
|
470 |
+ |
|
471 |
+ # Remove tips from nodes list, but keeping order. |
|
472 |
+ # internal_nodes <- df[!df$isTip,]$node |
|
473 |
+ # subtree_node_ids <- intersect(subtree_node_ids, internal_nodes) |
|
474 |
+ |
|
475 |
+ |
|
476 |
+ # Calculate the angle from the origin node to each child node. |
|
477 |
+ # Moving from parent to children in depth-first traversal. |
|
478 |
+ for( i in seq_along(subtree_node_ids) ){ |
|
479 |
+ parent_id <- subtree_node_ids[i] |
|
480 |
+ # Get angle from origin node to parent node. |
|
481 |
+ # Skip if parent_id is a tip. |
|
482 |
+ if(isTip.df(df, parent_id) ){ next } |
|
483 |
+ |
|
484 |
+ theta_parent <- getNodeAngle.df(df, origin_id, parent_id) |
|
485 |
+ |
|
486 |
+ children_ids <- getChild.df(df, parent_id) |
|
487 |
+ |
|
488 |
+ for( j in seq_along(children_ids)){ |
|
489 |
+ #delta_x <- df[subtree_node_id, 'x'] - df[origin_id, 'x'] |
|
490 |
+ #delta_y <- df[subtree_node_id, 'y'] - df[origin_id, 'y'] |
|
491 |
+ #angles[i] <- atan2(delta_y, delta_x) / pi |
|
492 |
+ child_id <- children_ids[j] |
|
493 |
+ # Skip if child is parent node of subtree. |
|
494 |
+ if( child_id == origin_id ){ |
|
495 |
+ next |
|
496 |
+ } |
|
497 |
+ |
|
498 |
+ theta_child <- getNodeAngle.df(df, origin_id, child_id) |
|
499 |
+ |
|
500 |
+ # Skip if child node is already inside arc. |
|
501 |
+ # if left < right angle (arc crosses 180/-180 quadrant) and child node is not inside arc of tree. |
|
502 |
+ # OR if left > right angle (arc crosses 0/360 quadrant) and child node is inside gap |
|
503 |
+ if ( (arc['left'] < arc['right'] & !( theta_child > arc['left'] & theta_child < arc['right'])) | |
|
504 |
+ (arc['left'] > arc['right'] & ( theta_child < arc['left'] & theta_child > arc['right'])) ){ |
|
505 |
+ # child node inside arc. |
|
506 |
+ next |
|
507 |
+ } |
|
508 |
+ |
|
509 |
+ |
|
510 |
+ delta <- theta_child - theta_parent |
|
511 |
+ delta_adj <- delta |
|
512 |
+ # Correct the delta if parent and child angles cross the 180/-180 half of circle. |
|
513 |
+ # If delta > 180 |
|
514 |
+ if( delta > 1){ # Edge between parent and child cross upper and lower quadrants of cirlce on 180/-180 side. |
|
515 |
+ delta_adj <- delta - 2 # delta' = delta - 360 |
|
516 |
+ # If delta < -180 |
|
517 |
+ }else if( delta < -1){ # Edge between parent and child cross upper and lower quadrants of cirlce |
|
518 |
+ delta_adj <- delta + 2 # delta' = delta - 360 |
|
519 |
+ } |
|
520 |
+ |
|
521 |
+ theta_child_adj <- theta_child |
|
522 |
+ |
|
523 |
+ # If angle change from parent to node is positive (anti-clockwise), check left angle |
|
524 |
+ if(delta_adj > 0){ |
|
525 |
+ # If child/parent edges cross the -180/180 quadrant (angle between them is > 180), |
|
526 |
+ # check if right angle and child angle are different signs and adjust if needed. |
|
527 |
+ if( abs(delta) > 1){ |
|
528 |
+ if( arc['left'] > 0 & theta_child < 0){ |
|
529 |
+ theta_child_adj <- theta_child + 2 |
|
530 |
+ }else if (arc['left'] < 0 & theta_child > 0){ |
|
531 |
+ theta_child_adj <- theta_child - 2 |
|
532 |
+ } |
|
533 |
+ } |
|
534 |
+ |
|
535 |
+ # check if left angle of arc is less than angle of child. Update if true. |
|
536 |
+ if( arc['left'] < theta_child_adj ){ |
|
537 |
+ arc['left'] <- theta_child |
|
538 |
+ } |
|
539 |
+ # If angle change from parent to node is negative (clockwise), check right angle |
|
540 |
+ }else if(delta_adj < 0){ |
|
541 |
+ # If child/parent edges cross the -180/180 quadrant (angle between them is > 180), |
|
542 |
+ # check if right angle and child angle are different signs and adjust if needed. |
|
543 |
+ if( abs(delta) > 1){ |
|
544 |
+ # Else change in angle from parent to child is negative, then adjust child angle if right angle is a different sign. |
|
545 |
+ if( arc['right'] > 0 & theta_child < 0){ |
|
546 |
+ theta_child_adj <- theta_child + 2 |
|
547 |
+ }else if (arc['right'] < 0 & theta_child > 0){ |
|
548 |
+ theta_child_adj <- theta_child - 2 |
|
549 |
+ } |
|
550 |
+ } |
|
551 |
+ # check if right angle of arc is greater than angle of child. Update if true. |
|
552 |
+ if( arc['right'] > theta_child_adj ){ |
|
553 |
+ arc['right'] <- theta_child |
|
213 | 554 |
} |
214 | 555 |
|
556 |
+ } |
|
215 | 557 |
} |
216 | 558 |
|
217 |
- return(df) |
|
559 |
+ } |
|
560 |
+ # Convert arc angles of [1, -1] to [2,0] domain. |
|
561 |
+ arc[arc<0] <- arc[arc<0] + 2 |
|
562 |
+ return(arc) |
|
563 |
+ |
|
564 |
+} |
|
565 |
+ |
|
566 |
+##' Rotate the points in a tree data.frame around a pivot node by the angle specified. |
|
567 |
+##' |
|
568 |
+##' @title rotateTreePoints.data.fram |
|
569 |
+##' @param df tree data.frame |
|
570 |
+##' @param pivot_node is the id of the pivot node. |
|
571 |
+##' @param nodes list of node numbers that are to be rotated by angle around the pivot_node |
|
572 |
+##' @param angle in range [0,2], ie degrees/180, radians/pi |
|
573 |
+##' @return updated tree data.frame with points rotated by angle |
|
574 |
+rotateTreePoints.df <- function(df, pivot_node, nodes, angle){ |
|
575 |
+ # Rotate nodes around pivot_node. |
|
576 |
+ # x' = cos(angle)*delta_x - sin(angle)*delta_y + delta_x |
|
577 |
+ # y' = sin(angle)*delta_x + cos(angle)*delta_y + delta_y |
|
578 |
+ |
|
579 |
+ cospitheta <- cospi(angle) |
|
580 |
+ sinpitheta <- sinpi(angle) |
|
581 |
+ for(node in nodes){ |
|
582 |
+ # Update (x,y) of node |
|
583 |
+ delta_x <- df[node, 'x'] - df[pivot_node, 'x'] |
|
584 |
+ delta_y <- df[node, 'y'] - df[pivot_node, 'y'] |
|
585 |
+ df[node, 'x'] <- cospitheta * delta_x - sinpitheta * delta_y + df[pivot_node, 'x'] |
|
586 |
+ df[node, 'y'] <- sinpitheta * delta_x + cospitheta * delta_y + df[pivot_node, 'y'] |
|
587 |
+ |
|
588 |
+ # Update label angle if not root node. |
|
589 |
+ # get parent |
|
590 |
+ parent_id <- getParent.df(df, node) |
|
591 |
+ # if 'node' is not root, then update label angle. |
|
592 |
+ if( parent_id != 0){ |
|
593 |
+ theta_parent_child <- getNodeAngle.df(df, parent_id, node) |
|
594 |
+ if(!is.na(theta_parent_child)){ |
|
595 |
+ # Update label angle |
|
596 |
+ df[node, 'angle'] <- -90 - 180 * theta_parent_child * sign(theta_parent_child - 1) |
|
597 |
+ } |
|
598 |
+ } |
|
599 |
+ |
|
600 |
+ } |
|
601 |
+ return(df) |
|
602 |
+} |
|
603 |
+ |
|
604 |
+##' Get the angle between the two nodes specified. |
|
605 |
+##' |
|
606 |
+##' @title getNodeAngle.df |
|
607 |
+##' @param df tree data.frame |
|
608 |
+##' @param origin_node_id origin node id number |
|
609 |
+##' @param node_id end node id number |
|
610 |
+##' @return angle in range [-1, 1], i.e. degrees/180, radians/pi |
|
611 |
+getNodeAngle.df <- function(df, origin_node_id, node_id){ |
|
612 |
+ if(origin_node_id != node_id){ |
|
613 |
+ delta_x <- df[node_id, 'x'] - df[origin_node_id, 'x'] |
|
614 |
+ delta_y <- df[node_id, 'y'] - df[origin_node_id, 'y'] |
|
615 |
+ angle <- atan2(delta_y, delta_x) / pi |
|
616 |
+ return( angle ) |
|
617 |
+ }else{ |
|
618 |
+ return(NA) |
|
619 |
+ } |
|
218 | 620 |
} |
219 | 621 |
|
622 |
+ |
|
623 |
+ |
|
624 |
+##' Get all children of node from tree, including start_node. |
|
625 |
+##' |
|
626 |
+##' @title getSubtree |
|
627 |
+##' @param tree ape phylo tree object |
|
628 |
+##' @param node is the tree node id from which the tree is derived. |
|
629 |
+##' @return list of all child node id's from starting node. |
|
630 |
+getSubtree <- function(tree, node){ |
|
631 |
+ |
|
632 |
+ subtree <- c(node) |
|
633 |
+ i <- 1 |
|
634 |
+ while( i <= length(subtree)){ |
|
635 |
+ subtree <- c(subtree, getChild(tree, subtree[i])) |
|
636 |
+ # remove any '0' root nodes |
|
637 |
+ subtree <- subtree[subtree != 0] |
|
638 |
+ i <- i + 1 |
|
639 |
+ } |
|
640 |
+ return(subtree) |
|
641 |
+} |
|
642 |
+ |
|
643 |
+##' Get all children of node from df tree using breath-first. |
|
644 |
+##' |
|
645 |
+##' @title GetSubtree.df |
|
646 |
+##' @param df tree data.frame |
|
647 |
+##' @param node id of starting node. |
|
648 |
+##' @return list of all child node id's from starting node. |
|
649 |
+GetSubtree.df <- function(df, node){ |
|
650 |
+ subtree <- c(node) |
|
651 |
+ i <- 1 |
|
652 |
+ while( i <= length(subtree)){ |
|
653 |
+ subtree <- c(subtree, getChild.df(df, subtree[i])) |
|
654 |
+ # remove any '0' root nodes |
|
655 |
+ subtree <- subtree[subtree != 0] |
|
656 |
+ i <- i + 1 |
|
657 |
+ } |
|
658 |
+ return(subtree) |
|
659 |
+} |
|
660 |
+ |
|
661 |
+##' Get all subtrees of specified node. This includes all ancestors and relatives of node and |
|
662 |
+##' return named list of subtrees. |
|
663 |
+##' |
|
664 |
+##' @title GetSubtreeUnrooted |
|
665 |
+##' @param tree ape phylo tree object |
|
666 |
+##' @param node is the tree node id from which the subtrees are derived. |
|
667 |
+##' @return named list of subtrees with the root id of subtree and list of node id's making up subtree. |
|
668 |
+GetSubtreeUnrooted <- function(tree, node){ |
|
669 |
+ # if node leaf, return nothing. |
|
670 |
+ if( isTip(tree, node) ){ |
|
671 |
+ # return NA |
|
672 |
+ return(NA) |
|
673 |
+ } |
|
674 |
+ |
|
675 |
+ subtrees <- list() |
|
676 |
+ |
|
677 |
+ # get subtree for each child node. |
|
678 |
+ children_ids <- getChild(tree, node) |
|
679 |
+ |
|
680 |
+ remaining_nodes <- getNodes_by_postorder(tree) |
|
681 |
+ # Remove current node from remaining_nodes list. |
|
682 |
+ remaining_nodes <- setdiff(remaining_nodes, node) |
|
683 |
+ |
|
684 |
+ |
|
685 |
+ for( child in children_ids ){ |
|
686 |
+ # Append subtree nodes to list if not 0 (root). |
|
687 |
+ subtree <- getSubtree(tree, child) |
|
688 |
+ subtrees[[length(subtrees)+1]] <- list( node = child, subtree = subtree) |
|
689 |
+ # remove subtree nodes from remaining nodes. |
|
690 |
+ remaining_nodes <- setdiff(remaining_nodes, as.integer(unlist(subtrees[[length(subtrees)]]['subtree']) )) |
|
691 |
+ } |
|
692 |
+ |
|
693 |
+ # The remaining nodes that are not found in the child subtrees are the remaining subtree nodes. |
|
694 |
+ # ie, parent node and all other nodes. We don't care how they are connect, just their ids. |
|
695 |
+ parent_id <- getParent(tree, node) |
|
696 |
+ # If node is not root, add remainder of tree nodes as subtree. |
|
697 |
+ if( parent_id != 0 & length(remaining_nodes) >= 1){ |
|
698 |
+ subtrees[[length(subtrees)+1]] <- list( node = parent_id, subtree = remaining_nodes) |
|
699 |
+ } |
|
700 |
+ |
|
701 |
+ return(subtrees) |
|
702 |
+} |
|
703 |
+ |
|
704 |
+ |
|
705 |
+##' Get all subtrees of node, as well as remaining branches of parent (ie, rest of tree structure as subtree) |
|
706 |
+##' return named list of subtrees with list name as starting node id. |
|
707 |
+##' @title GetSubtreeUnrooted |
|
708 |
+##' @param df tree data.frame |
|
709 |
+##' @param node is the tree node id from which the subtrees are derived. |
|
710 |
+##' @return named list of subtrees with the root id of subtree and list of node id's making up subtree. |
|
711 |
+getSubtreeUnrooted.df <- function(df, node){ |
|
712 |
+ # if node leaf, return nothing. |
|
713 |
+ if( isTip.df(df, node) ){ |
|
714 |
+ return(NA) |
|
715 |
+ } |
|
716 |
+ |
|
717 |
+ subtrees <- list() |
|
718 |
+ |
|
719 |
+ # get subtree for each child node. |
|
720 |
+ children_ids <- getChild.df(df, node) |
|
721 |
+ |
|
722 |
+ # remaining_nodes <- getNodes_by_postorder(tree) |
|
723 |
+ remaining_nodes <- df$node |
|
724 |
+ |
|
725 |
+ # Remove current node from remaining_nodes list. |
|
726 |
+ remaining_nodes <- setdiff(remaining_nodes, node) |
|
727 |
+ |
|
728 |
+ for( child in children_ids ){ |
|
729 |
+ subtree <- GetSubtree.df(df, child) |
|
730 |
+ # Append subtree nodes to list if more than 1 node in subtree (i.e. not a tip) |
|
731 |
+ #if(length(subtree) >= 2){ |
|
732 |
+ subtrees[[length(subtrees)+1]] <- list( node = child, subtree = subtree) |
|
733 |
+ # remove subtree nodes from remaining nodes. |
|
734 |
+ remaining_nodes <- setdiff(remaining_nodes, as.integer(unlist(subtrees[[length(subtrees)]]['subtree']) )) |
|
735 |
+ #}else{ |
|
736 |
+ # remove remaining nodes |
|
737 |
+ # remaining_nodes <- setdiff(remaining_nodes, subtree) |
|
738 |
+ #} |
|
739 |
+ } |
|
740 |
+ |
|
741 |
+ # The remaining nodes that are not found in the child subtrees are the remaining subtree nodes. |
|
742 |
+ # ie, parent node and all other nodes. We don't care how they are connected, just their id. |
|
743 |
+ parent_id <- getParent.df(df, node) |
|
744 |
+ # If node is not root. |
|
745 |
+ if( parent_id != 0 & length(remaining_nodes) >= 1){ |
|
746 |
+ subtrees[[length(subtrees)+1]] <- list( node = parent_id, subtree = remaining_nodes) |
|
747 |
+ } |
|
748 |
+ |
|
749 |
+ return(subtrees) |
|
750 |
+} |
|
751 |
+ |
|
752 |
+ |
|
753 |
+getRoot.df <- function(df, node){ |
|
754 |
+ root <- which(is.na(df$parent)) |
|
755 |
+ return(root) |
|
756 |
+} |
|
757 |
+ |
|
758 |
+##' Get parent node id of child node. |
|
759 |
+##' |
|
760 |
+##' @title getParent.df |
|
761 |
+##' @param df tree data.frame |
|
762 |
+##' @param node is the node id of child in tree. |
|
763 |
+##' @return integer node id of parent |
|
220 | 764 |
getParent.df <- function(df, node) { |
221 | 765 |
i <- which(df$node == node) |
222 |
- res <- df$parent[i] |
|
223 |
- if (res == node) { |
|
766 |
+ parent_id <- df$parent[i] |
|
767 |
+ if (parent_id == node | is.na(parent_id)) { |
|
224 | 768 |
## root node |
225 | 769 |
return(0) |
226 | 770 |
} |
227 |
- return(res) |
|
771 |
+ return(parent_id) |
|
228 | 772 |
} |
229 | 773 |
|
230 | 774 |
getAncestor.df <- function(df, node) { |
231 | 775 |
anc <- getParent.df(df, node) |
232 | 776 |
anc <- anc[anc != 0] |
233 | 777 |
if (length(anc) == 0) { |
234 |
- stop("selected node is root...") |
|
778 |
+ # stop("selected node is root...") |
|
779 |
+ return(0) |
|
235 | 780 |
} |
236 | 781 |
i <- 1 |
237 | 782 |
while(i<= length(anc)) { |
... | ... |
@@ -243,6 +788,12 @@ getAncestor.df <- function(df, node) { |
243 | 788 |
} |
244 | 789 |
|
245 | 790 |
|
791 |
+##' Get list of child node id numbers of parent node |
|
792 |
+##' |
|
793 |
+##' @title getChild.df |
|
794 |
+##' @param df tree data.frame |
|
795 |
+##' @param node is the node id of child in tree. |
|
796 |
+##' @return list of child node ids of parent |
|
246 | 797 |
getChild.df <- function(df, node) { |
247 | 798 |
i <- which(df$parent == node) |
248 | 799 |
if (length(i) == 0) { |
... | ... |
@@ -257,7 +808,8 @@ get.offspring.df <- function(df, node) { |
257 | 808 |
sp <- getChild.df(df, node) |
258 | 809 |
sp <- sp[sp != 0] |
259 | 810 |
if (length(sp) == 0) { |
260 |
- stop("input node is a tip...") |
|
811 |
+ #stop("input node is a tip...") |
|
812 |
+ return(0) |
|
261 | 813 |
} |
262 | 814 |
|
263 | 815 |
i <- 1 |
... | ... |
@@ -305,7 +857,6 @@ get.offspring.tip <- function(tr, node) { |
305 | 857 |
## N <- Ntip + Nnode |
306 | 858 |
## return(N) |
307 | 859 |
## } |
308 |
- |
|
309 | 860 |
getParent <- function(tr, node) { |
310 | 861 |
if ( node == getRoot(tr) ) |
311 | 862 |
return(0) |
... | ... |
@@ -323,7 +874,9 @@ getParent <- function(tr, node) { |
323 | 874 |
} |
324 | 875 |
|
325 | 876 |
getChild <- function(tr, node) { |
877 |
+ # Get edge matrix from phylo object. |
|
326 | 878 |
edge <- tr[["edge"]] |
879 |
+ # Select all rows that match "node". |
|
327 | 880 |
res <- edge[edge[,1] == node, 2] |
328 | 881 |
## if (length(res) == 0) { |
329 | 882 |
## ## is a tip |
... | ... |
@@ -363,6 +916,16 @@ isRoot <- function(tr, node) { |
363 | 916 |
getRoot(tr) == node |
364 | 917 |
} |
365 | 918 |
|
919 |
+isTip <- function(tr, node) { |
|
920 |
+ children_ids <- getChild(tr, node) |
|
921 |
+ length(children_ids) == 0 |
|
922 |
+} |
|
923 |
+ |
|
924 |
+isTip.df <- function(df, node) { |
|
925 |
+ return(df[node, 'isTip']) |
|
926 |
+} |
|
927 |
+ |
|
928 |
+ |
|
366 | 929 |
getNodeName <- function(tr) { |
367 | 930 |
if (is.null(tr$node.label)) { |
368 | 931 |
n <- length(tr$tip.label) |
... | ... |
@@ -400,7 +963,6 @@ getNodeName <- function(tr) { |
400 | 963 |
## } |
401 | 964 |
## return(root) |
402 | 965 |
## } |
403 |
- |
|
404 | 966 |
get.trunk <- function(tr) { |
405 | 967 |
root <- getRoot(tr) |
406 | 968 |
path_length <- sapply(1:(root-1), function(x) get.path_length(tr, root, x)) |
... | ... |
@@ -459,10 +1021,54 @@ get.path_length <- function(phylo, from, to, weight=NULL) { |
459 | 1021 |
} |
460 | 1022 |
|
461 | 1023 |
getNodes_by_postorder <- function(tree) { |
462 |
- tree <- reorder.phylo(tree, "postorder") |
|
1024 |
+ tree <- reorder.phylo(tree, "postorder") |
|
463 | 1025 |
unique(rev(as.vector(t(tree$edge[,c(2,1)])))) |
464 | 1026 |
} |
465 | 1027 |
|
1028 |
+#getNodes_by_postorder.df <- function(df) { |
|
1029 |
+ #tree <- reorder.phylo(tree, "postorder") |
|
1030 |
+ #unique(rev(as.vector(t(tree$edge[,c(2,1)])))) |
|
1031 |
+#} |
|
1032 |
+ |
|
1033 |
+##' Get the nodes of tree from root in breadth-first order. |
|
1034 |
+##' |
|
1035 |
+##' @title getNodesBreadthFirst.df |
|
1036 |
+##' @param df tree data.frame |
|
1037 |
+##' @return list of node id's in breadth-first order. |
|
1038 |
+getNodesBreadthFirst.df <- function(df){ |
|
1039 |
+ |
|
1040 |
+ root <- getRoot.df(df) |
|
1041 |
+ if(isTip.df(df, root)){ |
|
1042 |
+ return(root) |
|
1043 |
+ } |
|
1044 |
+ |
|
1045 |
+ tree_size <- nrow(df) |
|
1046 |
+ # initialise list of nodes |
|
1047 |
+ res <- root |
|
1048 |
+ |
|
1049 |
+ i <- 1 |
|
1050 |
+ while(length(res) < tree_size){ |
|
1051 |
+ parent <- res[i] |
|
1052 |
+ i <- i + 1 |
|
1053 |
+ |
|
1054 |
+ # Skip if parent is a tip. |
|
1055 |
+ if(isTip.df(df, parent)){ |
|
1056 |
+ next |
|
1057 |
+ } |
|
1058 |
+ |
|
1059 |
+ # get children of current parent. |
|
1060 |
+ children <- getChild.df(df,parent) |
|
1061 |
+ |
|
1062 |
+ # add children to result |
|
1063 |
+ res <- c(res, children) |
|
1064 |
+ |
|
1065 |
+ } |
|
1066 |
+ |
|
1067 |
+ return(res) |
|
1068 |
+ |
|
1069 |
+} |
|
1070 |
+ |
|
1071 |
+ |
|
466 | 1072 |
getXcoord2 <- function(x, root, parent, child, len, start=0, rev=FALSE) { |
467 | 1073 |
x[root] <- start |
468 | 1074 |
x[-root] <- NA ## only root is set to start, by default 0 |
... | ... |
@@ -819,6 +1425,7 @@ add_angle_slanted <- function(res) { |
819 | 1425 |
theta <- atan(dy/dx) |
820 | 1426 |
theta[is.na(theta)] <- 0 ## root node |
821 | 1427 |
res$angle <- theta/pi * 180 |
1428 |
+ |
|
822 | 1429 |
branch.y <- (res[res$parent, "y"] + res[, "y"])/2 |
823 | 1430 |
idx <- is.na(branch.y) |
824 | 1431 |
branch.y[idx] <- res[idx, "y"] |
... | ... |
@@ -929,8 +1536,6 @@ set_branch_length <- function(tree_object, branch.length) { |
929 | 1536 |
|
930 | 1537 |
## return(phylo) |
931 | 1538 |
## } |
932 |
- |
|
933 |
- |
|
934 | 1539 |
re_assign_ycoord_df <- function(df, currentNode) { |
935 | 1540 |
while(anyNA(df$y)) { |
936 | 1541 |
pNode <- with(df, parent[match(currentNode, node)]) %>% unique |
... | ... |
@@ -959,7 +1564,6 @@ re_assign_ycoord_df <- function(df, currentNode) { |
959 | 1564 |
## is.ggtree <- function(x) inherits(x, 'ggtree') |
960 | 1565 |
|
961 | 1566 |
|
962 |
- |
|
963 | 1567 |
calculate_angle <- function(data) { |
964 | 1568 |
data$angle <- 360/(diff(range(data$y)) + 1) * data$y |
965 | 1569 |
return(data) |
... | ... |
@@ -4,9 +4,9 @@ ggtree: an R package for visualization and annotation of phylogenetic trees with |
4 | 4 |
|
5 | 5 |
<img src="https://raw.githubusercontent.com/Bioconductor/BiocStickers/master/ggtree/ggtree.png" height="200" align="right" /> |
6 | 6 |
|
7 |
-[](https://bioconductor.org/packages/ggtree) [](https://github.com/guangchuangyu/ggtree) [](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since) [](https://bioconductor.org/packages/stats/bioc/ggtree) [](https://bioconductor.org/packages/stats/bioc/ggtree) |
|
7 |
+[](https://bioconductor.org/packages/ggtree) [](https://github.com/guangchuangyu/ggtree) [](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#since) [](https://bioconductor.org/packages/stats/bioc/ggtree) [](https://bioconductor.org/packages/stats/bioc/ggtree) |
|
8 | 8 |
|
9 |
-[](http://www.repostatus.org/#active) [](https://codecov.io/gh/GuangchuangYu/ggtree) [](https://github.com/GuangchuangYu/ggtree/commits/master) [](https://github.com/GuangchuangYu/ggtree/network) [](https://github.com/GuangchuangYu/ggtree/stargazers) [](https://awesome-r.com/#awesome-r-graphic-displays) |
|
9 |
+[](http://www.repostatus.org/#active) [](https://codecov.io/gh/GuangchuangYu/ggtree) [](https://github.com/GuangchuangYu/ggtree/commits/master) [](https://github.com/GuangchuangYu/ggtree/network) [](https://github.com/GuangchuangYu/ggtree/stargazers) [](https://awesome-r.com/#awesome-r-graphic-displays) |
|
10 | 10 |
|
11 | 11 |
[](https://www.bioconductor.org/packages/devel/bioc/html/ggtree.html#archives) [](https://bioconductor.org/checkResults/devel/bioc-LATEST/ggtree/) [](https://travis-ci.org/GuangchuangYu/ggtree) [](https://ci.appveyor.com/project/GuangchuangYu/ggtree) [](http://bioconda.github.io/recipes/bioconductor-ggtree/README.html) |
12 | 12 |
|
... | ... |
@@ -20,7 +20,7 @@ Please cite the following article when using `ggtree`: |
20 | 20 |
|
21 | 21 |
**G Yu**, DK Smith, H Zhu, Y Guan, TTY Lam<sup>\*</sup>. ggtree: an R package for visualization and annotation of phylogenetic trees with their covariates and other associated data. ***Methods in Ecology and Evolution***. 2017, 8(1):28-36. |
22 | 22 |
|
23 |
-[](http://dx.doi.org/10.1111/2041-210X.12628) [](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627) [](https://www.altmetric.com/details/10533079) |
|
23 |
+[](http://dx.doi.org/10.1111/2041-210X.12628) [](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627) [](https://www.altmetric.com/details/10533079) |
|
24 | 24 |
|
25 | 25 |
------------------------------------------------------------------------ |
26 | 26 |
|
... | ... |
@@ -33,15 +33,15 @@ For details, please visit our project website, <https://guangchuangyu.github.io/ |
33 | 33 |
|
34 | 34 |
### Citation |
35 | 35 |
|
36 |
-[](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627) |
|
36 |
+[](https://scholar.google.com.hk/scholar?oi=bibs&hl=en&cites=7268358477862164627) |
|
37 | 37 |
|
38 | 38 |
+-+---------+---------+---------+---------+---------+---+ |
39 | 39 |
| * | |
40 |
+ 12 + + |
|
41 |
+ | | |
|
40 | 42 |
10 + + |
41 | 43 |
| | |
42 | 44 |
8 + + |
43 |
- | | |
|
44 |
- | | |
|
45 | 45 |
6 + + |
46 | 46 |
| | |
47 | 47 |
4 + + |
... | ... |
@@ -53,30 +53,30 @@ For details, please visit our project website, <https://guangchuangyu.github.io/ |
53 | 53 |
|
54 | 54 |
### Download stats |
55 | 55 |
|
56 |
-[](https://bioconductor.org/packages/stats/bioc/ggtree) [](https://bioconductor.org/packages/stats/bioc/ggtree) [](https://bioconductor.org/packages/stats/bioc/ggtree) |
|
56 |
+[](https://bioconductor.org/packages/stats/bioc/ggtree) [](https://bioconductor.org/packages/stats/bioc/ggtree) [](https://bioconductor.org/packages/stats/bioc/ggtree) |
|
57 | 57 |
|
58 |
- ++-------------------+-------------------+--------------------+-------------------+-----------+ |
|
59 |
- | * | |
|
60 |
- | * * | |
|
58 |
+ ++-------------------+------------------+-------------------+------------------+--------------+ |
|
59 |
+ 3000 + * + |
|
61 | 60 |
| | |
62 |
- | * * | |
|
63 | 61 |
| | |
64 |
- 1500 + + |
|
62 |
+ 2500 + + |
|
65 | 63 |
| | |
66 |
- | * | |
|
67 |
- | * | |
|
68 |
- | * * * | |
|
69 |
- 1000 + * * + |
|
70 | 64 |
| | |
71 |
- | * * | |
|
72 |
- | * | |
|
73 |
- | * * * | |
|
74 | 65 |
| | |
75 |
- 500 + * + |
|
76 |
- | * * | |
|
77 |
- | * | |
|
78 |
- | * | |
|
66 |
+ 2000 + + |
|
67 |
+ | * * * | |
|
68 |
+ | * * | |
|
69 |
+ 1500 + + |
|
79 | 70 |
| | |
71 |
+ | * | |
|
72 |
+ | * * * * | |
|
73 |
+ 1000 + * * + |
|
74 |
+ | * * | |
|
75 |
+ | * * * | |
|
76 |
+ | * | |
|
77 |
+ 500 + * * + |
|
78 |
+ | * * | |
|
79 |
+ | * | |
|
80 | 80 |
0 + * * * + |
81 |
- ++-------------------+-------------------+--------------------+-------------------+-----------+ |
|
82 |
- 2015 2015.5 2016 2016.5 2017 |
|
81 |
+ ++-------------------+------------------+-------------------+------------------+--------------+ |
|
82 |
+ 2015 2015.5 2016 2016.5 2017 |
83 | 83 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,20 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{GetSubtree.df} |
|
4 |
+\alias{GetSubtree.df} |
|
5 |
+\title{GetSubtree.df} |
|
6 |
+\usage{ |
|
7 |
+GetSubtree.df(df, node) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{df}{tree data.frame} |
|
11 |
+ |
|
12 |
+\item{node}{id of starting node.} |
|
13 |
+} |
|
14 |
+\value{ |
|
15 |
+list of all child node id's from starting node. |
|
16 |
+} |
|
17 |
+\description{ |
|
18 |
+Get all children of node from df tree using breath-first. |
|
19 |
+} |
|
20 |
+ |
0 | 21 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,21 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{GetSubtreeUnrooted} |
|
4 |
+\alias{GetSubtreeUnrooted} |
|
5 |
+\title{GetSubtreeUnrooted} |
|
6 |
+\usage{ |
|
7 |
+GetSubtreeUnrooted(tree, node) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{tree}{ape phylo tree object} |
|
11 |
+ |
|
12 |
+\item{node}{is the tree node id from which the subtrees are derived.} |
|
13 |
+} |
|
14 |
+\value{ |
|
15 |
+named list of subtrees with the root id of subtree and list of node id's making up subtree. |
|
16 |
+} |
|
17 |
+\description{ |
|
18 |
+Get all subtrees of specified node. This includes all ancestors and relatives of node and |
|
19 |
+return named list of subtrees. |
|
20 |
+} |
|
21 |
+ |
0 | 22 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,21 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{applyLayoutDaylight} |
|
4 |
+\alias{applyLayoutDaylight} |
|
5 |
+\title{applyLayoutDaylight} |
|
6 |
+\usage{ |
|
7 |
+applyLayoutDaylight(df, node_id) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{df}{tree data.frame} |
|
11 |
+ |
|
12 |
+\item{node_id}{is id of the node from which daylight is measured to the other subtrees.} |
|
13 |
+} |
|
14 |
+\value{ |
|
15 |
+list with tree data.frame with updated layout using daylight algorithm and max_change angle. |
|
16 |
+} |
|
17 |
+\description{ |
|
18 |
+Apply the daylight alorithm to adjust the spacing between the subtrees and tips of the |
|
19 |
+specified node. |
|
20 |
+} |
|
21 |
+ |
0 | 22 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,20 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{getChild.df} |
|
4 |
+\alias{getChild.df} |
|
5 |
+\title{getChild.df} |
|
6 |
+\usage{ |
|
7 |
+getChild.df(df, node) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{df}{tree data.frame} |
|
11 |
+ |
|
12 |
+\item{node}{is the node id of child in tree.} |
|
13 |
+} |
|
14 |
+\value{ |
|
15 |
+list of child node ids of parent |
|
16 |
+} |
|
17 |
+\description{ |
|
18 |
+Get list of child node id numbers of parent node |
|
19 |
+} |
|
20 |
+ |
0 | 21 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,22 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{getNodeAngle.df} |
|
4 |
+\alias{getNodeAngle.df} |
|
5 |
+\title{getNodeAngle.df} |
|
6 |
+\usage{ |
|
7 |
+getNodeAngle.df(df, origin_node_id, node_id) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{df}{tree data.frame} |
|
11 |
+ |
|
12 |
+\item{origin_node_id}{origin node id number} |
|
13 |
+ |
|
14 |
+\item{node_id}{end node id number} |
|
15 |
+} |
|
16 |
+\value{ |
|
17 |
+angle in range [-1, 1], i.e. degrees/180, radians/pi |
|
18 |
+} |
|
19 |
+\description{ |
|
20 |
+Get the angle between the two nodes specified. |
|
21 |
+} |
|
22 |
+ |
0 | 23 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,18 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{getNodesBreadthFirst.df} |
|
4 |
+\alias{getNodesBreadthFirst.df} |
|
5 |
+\title{getNodesBreadthFirst.df} |
|
6 |
+\usage{ |
|
7 |
+getNodesBreadthFirst.df(df) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{df}{tree data.frame} |
|
11 |
+} |
|
12 |
+\value{ |
|
13 |
+list of node id's in breadth-first order. |
|
14 |
+} |
|
15 |
+\description{ |
|
16 |
+Get the nodes of tree from root in breadth-first order. |
|
17 |
+} |
|
18 |
+ |
0 | 19 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,20 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{getParent.df} |
|
4 |
+\alias{getParent.df} |
|
5 |
+\title{getParent.df} |
|
6 |
+\usage{ |
|
7 |
+getParent.df(df, node) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{df}{tree data.frame} |
|
11 |
+ |
|
12 |
+\item{node}{is the node id of child in tree.} |
|
13 |
+} |
|
14 |
+\value{ |
|
15 |
+integer node id of parent |
|
16 |
+} |
|
17 |
+\description{ |
|
18 |
+Get parent node id of child node. |
|
19 |
+} |
|
20 |
+ |
0 | 21 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,20 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{getSubtree} |
|
4 |
+\alias{getSubtree} |
|
5 |
+\title{getSubtree} |
|
6 |
+\usage{ |
|
7 |
+getSubtree(tree, node) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{tree}{ape phylo tree object} |
|
11 |
+ |
|
12 |
+\item{node}{is the tree node id from which the tree is derived.} |
|
13 |
+} |
|
14 |
+\value{ |
|
15 |
+list of all child node id's from starting node. |
|
16 |
+} |
|
17 |
+\description{ |
|
18 |
+Get all children of node from tree, including start_node. |
|
19 |
+} |
|
20 |
+ |
0 | 21 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,21 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{getSubtreeUnrooted.df} |
|
4 |
+\alias{getSubtreeUnrooted.df} |
|
5 |
+\title{GetSubtreeUnrooted} |
|
6 |
+\usage{ |
|
7 |
+getSubtreeUnrooted.df(df, node) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{df}{tree data.frame} |
|
11 |
+ |
|
12 |
+\item{node}{is the tree node id from which the subtrees are derived.} |
|
13 |
+} |
|
14 |
+\value{ |
|
15 |
+named list of subtrees with the root id of subtree and list of node id's making up subtree. |
|
16 |
+} |
|
17 |
+\description{ |
|
18 |
+Get all subtrees of node, as well as remaining branches of parent (ie, rest of tree structure as subtree) |
|
19 |
+return named list of subtrees with list name as starting node id. |
|
20 |
+} |
|
21 |
+ |
0 | 22 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,23 @@ |
1 |
+% Generated by roxygen2: do not edit by hand |
|
2 |
+% Please edit documentation in R/tidytree.R |
|
3 |
+\name{getTreeArcAngles} |
|
4 |
+\alias{getTreeArcAngles} |
|
5 |
+\title{getTreeArcAngles} |
|
6 |
+\usage{ |
|
7 |
+getTreeArcAngles(df, origin_id, subtree) |
|
8 |
+} |
|
9 |
+\arguments{ |
|
10 |
+\item{df}{tree data.frame} |
|
11 |
+ |
|
12 |
+\item{origin_id}{node id from which to calculate left and right hand angles of subtree.} |
|
13 |
+ |
|
14 |
+\item{subtree}{named list of root id of subtree and list of node ids for given subtree.} |
|
15 |
+} |
|
16 |
+\value{ |
|
17 |
+named list with right and left angles in range [0,2] i.e 1 = 180 degrees, 1.5 = 270 degrees. |
|
18 |
+} |
|
19 |
+\description{ |
|
20 |
+Find the right (clockwise rotation, angle from +ve x-axis to furthest subtree nodes) and |
|
21 |
+left (anti-clockwise angle from +ve x-axis to subtree) |
|
22 |
+} |
|
23 |
+ |
... | ... |
@@ -8,8 +8,9 @@ |
8 | 8 |
\title{visualizing phylogenetic tree and heterogenous associated data based on grammar of graphics |
9 | 9 |
\code{ggtree} provides functions for visualizing phylogenetic tree and its associated data in R.} |
10 | 10 |
\usage{ |
11 |
-ggtree(tr, mapping = NULL, layout = "rectangular", open.angle = 0, |
|
12 |
- mrsd = NULL, as.Date = FALSE, yscale = "none", yscale_mapping = NULL, |
|
11 |
+ggtree(tr, mapping = NULL, layout = "rectangular", |
|
12 |