1 ## plotPhyloCoor.R (2012-02-14)
3 ## Coordinates of a Tree Plot
5 ## Copyright 2008 Damien de Vienne
7 ## This file is part of the R-package `ape'.
8 ## See the file ../COPYING for licensing issues.
11 function (x, type = "phylogram", use.edge.length = TRUE, node.pos = NULL,
12 direction = "rightwards", ...)
14 Ntip <- length(x$tip.label)
16 stop("found only one tip in the tree!")
17 Nedge <- dim(x$edge)[1]
18 if (any(tabulate(x$edge[, 1]) == 1))
19 stop("there are single (non-splitting) nodes in your tree; you may need to use collapse.singles().")
21 if (is.null(x$edge.length)) use.edge.length <- FALSE
22 phyloORclado <- type %in% c("phylogram", "cladogram")
23 horizontal <- direction %in% c("rightwards", "leftwards")
25 if (!is.null(attr(x, "order")))
26 if (attr(x, "order") == "pruningwise")
28 yy <- numeric(Ntip + Nnode)
29 TIPS <- x$edge[x$edge[, 2] <= Ntip, 2]
35 ## first reorder the tree in cladewise order to avoid cophyloplot() hanging:
36 x <- reorder(reorder(x), order = "pruningwise")
37 ereorder <- match(x$edge[, 2], xe[, 2])
40 if (is.null(node.pos)) {
42 if (type == "cladogram" && !use.edge.length)
46 yy <- .C("node_height", as.integer(Ntip), as.integer(Nnode),
47 as.integer(x$edge[, 1]), as.integer(x$edge[,
48 2]), as.integer(Nedge), as.double(yy), DUP = FALSE,
51 ans <- .C("node_height_clado", as.integer(Ntip),
52 as.integer(Nnode), as.integer(x$edge[, 1]), as.integer(x$edge[,
53 2]), as.integer(Nedge), double(Ntip + Nnode),
54 as.double(yy), DUP = FALSE, PACKAGE = "ape")
58 if (!use.edge.length) {
60 xx <- .C("node_depth", as.integer(Ntip), as.integer(Nnode),
61 as.integer(x$edge[, 1]), as.integer(x$edge[,
62 2]), as.integer(Nedge), double(Ntip + Nnode),
63 DUP = FALSE, PACKAGE = "ape")[[6]] - 1
67 xx <- .C("node_depth_edgelength", as.integer(Ntip),
68 as.integer(Nnode), as.integer(x$edge[, 1]), as.integer(x$edge[,
69 2]), as.integer(Nedge), as.double(x$edge.length),
70 double(Ntip + Nnode), DUP = FALSE, PACKAGE = "ape")[[7]]
73 ##if (type == "fan") {
74 ## TIPS <- xe[which(xe[, 2] <= Ntip), 2]
75 ## xx <- seq(0, 2 * pi * (1 - 1/Ntip), 2 * pi/Ntip)
76 ## theta <- double(Ntip)
78 ## theta <- c(theta, numeric(Nnode))
79 ## theta <- .C("node_height", as.integer(Ntip), as.integer(Nnode),
80 ## as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
81 ## as.integer(Nedge), theta, DUP = FALSE, PACKAGE = "ape")[[6]]
82 ## if (use.edge.length) {
83 ## r <- .C("node_depth_edgelength", as.integer(Ntip),
84 ## as.integer(Nnode), as.integer(x$edge[, 1]), as.integer(x$edge[,
85 ## 2]), as.integer(Nedge), as.double(x$edge.length),
86 ## double(Ntip + Nnode), DUP = FALSE, PACKAGE = "ape")[[7]]
89 ## r <- .C("node_depth", as.integer(Ntip), as.integer(Nnode),
90 ## as.integer(x$edge[, 1]), as.integer(x$edge[,
91 ## 2]), as.integer(Nedge), double(Ntip + Nnode),
92 ## DUP = FALSE, PACKAGE = "ape")[[6]]
95 ## xx <- r * cos(theta)
96 ## yy <- r * sin(theta)
98 ##if (type == "unrooted") {
99 ## XY <- if (use.edge.length)
100 ## unrooted.xy(Ntip, Nnode, x$edge, x$edge.length)
101 ## else unrooted.xy(Ntip, Nnode, x$edge, rep(1, Nedge))
102 ## xx <- XY$M[, 1] - min(XY$M[, 1])
103 ## yy <- XY$M[, 2] - min(XY$M[, 2])
105 ##if (type == "radial") {
106 ## X <- .C("node_depth", as.integer(Ntip), as.integer(Nnode),
107 ## as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
108 ## as.integer(Nedge), double(Ntip + Nnode), DUP = FALSE,
109 ## PACKAGE = "ape")[[6]]
112 ## yy <- c((1:Ntip) * 2 * pi/Ntip, rep(0, Nnode))
113 ## Y <- .C("node_height", as.integer(Ntip), as.integer(Nnode),
114 ## as.integer(x$edge[, 1]), as.integer(x$edge[, 2]),
115 ## as.integer(Nedge), as.double(yy), DUP = FALSE, PACKAGE = "ape")[[6]]
119 if (phyloORclado && direction != "rightwards") {
120 if (direction == "leftwards") {
127 xx <- tmp - min(tmp) + 1
128 if (direction == "downwards") {