1 ## write.tree.R (2009-03-23)
3 ## Write Tree File in Parenthetic Format
5 ## Copyright 2002-2009 Emmanuel Paradis and Daniel Lawson
7 ## This file is part of the R-package `ape'.
8 ## See the file ../COPYING for licensing issues.
10 checkLabel <- function(x, ...)
12 ## delete all leading and trailing spaces and tabs, and
13 ## the leading left and trailing right parentheses:
14 ## (the syntax will work with any mix of these characters,
15 ## e.g., " ( ( (( " will correctly be deleted)
16 x <- gsub("^[[:space:]\\(]+", "", x)
17 x <- gsub("[[:space:]\\)]+$", "", x)
18 ## replace all spaces and tabs by underscores:
19 x <- gsub("[[:space:]]", "_", x)
20 ## remove all commas, colons, and semicolons
21 x <- gsub("[,:;]", "", x)
22 ## replace left and right parentheses with dashes:
23 x <- gsub("[\\(\\)]", "-", x)
24 ## delete extra underscores and extra dashes:
25 x <- gsub("_{2,}", "_", x)
26 x <- gsub("-{2,}", "-", x)
31 function (phy, file = "", append = FALSE, digits = 10, tree.names = FALSE)
33 if (is.logical(tree.names)) {
34 output.tree.names <- tree.names
36 } else if (is.character(tree.names)) {
37 output.tree.names <- TRUE
38 names(tree) <- tree.names
40 if (output.tree.names)
41 names(tree) <- checkLabel(names(tree))
42 if (class(phy) == "multiPhylo") {
43 write.tree(phy[[1]], file = file, append = append,
44 digits = digits, tree.names = names[1])
46 for (i in 2:length(phy)) write.tree(phy[[i]], file = file,
47 append = TRUE, digits = digits, tree.names = names(phy)[i])
48 return(invisible(NULL))
50 if (class(phy) != "phylo")
51 stop("object \"phy\" is not of class \"phylo\"")
52 brl <- !is.null(phy$edge.length)
53 nodelab <- !is.null(phy$node.label)
54 phy$tip.label <- checkLabel(phy$tip.label)
55 if (nodelab) phy$node.label <- checkLabel(phy$node.label)
56 f.d <- paste("%.", digits, "g", sep = "")
57 cp <- function(s) STRING <<- paste(STRING, s, sep = "")
58 add.internal <- function(i) {
60 br <- which(phy$edge[, 1] == i)
62 desc <- phy$edge[j, 2]
66 if (j != br[length(br)])
71 cp(phy$node.label[i - n])
74 cp(sprintf(f.d, phy$edge.length[which(phy$edge[,
78 add.terminal <- function(i) {
79 cp(phy$tip.label[phy$edge[i, 2]])
82 cp(sprintf(f.d, phy$edge.length[i]))
85 n <- length(phy$tip.label)
87 if (output.tree.names) paste(tree.names, "(", sep = "") else "("
88 br <- which(phy$edge[, 1] == n + 1)
90 desc <- phy$edge[j, 2]
94 if (j != br[length(br)])
97 if (is.null(phy$root.edge)) {
100 cp(phy$node.label[1])
106 cp(phy$node.label[1])
108 cp(sprintf(f.d, phy$root.edge))
113 else cat(STRING, file = file, append = append, sep = "\n")