1 ## write.tree.R (2009-06-16)
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 output.tree.names <- FALSE
34 if (is.logical(tree.names)) {
35 output.tree.names <- tree.names
37 } else if (is.character(tree.names)) {
38 output.tree.names <- TRUE
39 names(phy) <- tree.names
41 if (output.tree.names)
42 names(phy) <- checkLabel(names(phy))
43 if (inherits(phy, "multiPhylo")) {
44 write.tree(phy[[1]], file = file, append = append,
45 digits = digits, tree.names = names(phy)[1])
47 for (i in 2:length(phy)) write.tree(phy[[i]], file = file,
48 append = TRUE, digits = digits, tree.names = names(phy)[i])
49 return(invisible(NULL))
51 if (!inherits(phy, "phylo"))
52 stop("object \"phy\" is not of class \"phylo\"")
53 brl <- !is.null(phy$edge.length)
54 nodelab <- !is.null(phy$node.label)
55 phy$tip.label <- checkLabel(phy$tip.label)
56 if (nodelab) phy$node.label <- checkLabel(phy$node.label)
57 f.d <- paste("%.", digits, "g", sep = "")
58 cp <- function(s) STRING <<- paste(STRING, s, sep = "")
59 add.internal <- function(i) {
61 br <- which(phy$edge[, 1] == i)
63 desc <- phy$edge[j, 2]
67 if (j != br[length(br)])
72 cp(phy$node.label[i - n])
75 cp(sprintf(f.d, phy$edge.length[which(phy$edge[,
79 add.terminal <- function(i) {
80 cp(phy$tip.label[phy$edge[i, 2]])
83 cp(sprintf(f.d, phy$edge.length[i]))
86 n <- length(phy$tip.label)
88 if (output.tree.names) paste(tree.names, "(", sep = "") else "("
89 br <- which(phy$edge[, 1] == n + 1)
91 desc <- phy$edge[j, 2]
95 if (j != br[length(br)])
98 if (is.null(phy$root.edge)) {
101 cp(phy$node.label[1])
107 cp(phy$node.label[1])
109 cp(sprintf(f.d, phy$root.edge))
114 else cat(STRING, file = file, append = append, sep = "\n")