1 ## write.nexus.R (2006-09-09)
3 ## Write Tree File in Nexus Format
5 ## Copyright 2003-2006 Emmanuel Paradis
7 ## This file is part of the R-package `ape'.
8 ## See the file ../COPYING for licensing issues.
10 write.nexus <- function(..., file = "", translate = TRUE, original.data = TRUE)
13 ## We insure that all trees are in a list, even if there is a single one:
14 if (length(obj) == 1) {
15 if (class(obj[[1]]) == "phylo") ntree <- 1
17 obj <- unlist(obj, recursive = FALSE)
20 } else ntree <- length(obj)
21 cat("#NEXUS\n", file = file)
22 cat(paste("[R-package APE, ", date(), "]\n\n", sep = ""),
23 file = file, append = TRUE)
25 if (!is.null(attr(obj[[1]], "origin"))) {
26 if (!file.exists(attr(obj[[1]], "origin"))) {
27 warning(paste("the file", attr(obj[[1]], "origin"),
29 the original data won't be written with the tree."))
30 original.data <- FALSE
33 ORI <- scan(file = attr(obj[[1]], "origin"), what = character(),
35 start <- grep("BEGIN TAXA;", ORI)
36 ORI <- ORI[-(1:(start - 1))]
37 ORI <- gsub("ENDBLOCK;", "END;", ORI)
38 endblock <- grep("END;", ORI)
39 start <- grep("BEGIN TREES;", ORI)
40 end <- endblock[endblock > start][1]
41 cat(ORI[1:(start - 1)], file = file, append = TRUE, sep = "\n")
45 else original.data <- FALSE
47 N <- length(obj[[1]]$tip.label)
49 cat("BEGIN TAXA;\n", file = file, append = TRUE)
50 cat(paste("\tDIMENSIONS NTAX = ", N, ";\n", sep = ""),
51 file = file, append = TRUE)
52 cat("\tTAXLABELS\n", file = file, append = TRUE)
53 cat(paste("\t\t", obj[[1]]$tip.label, sep = ""),
54 sep = "\n", file = file, append = TRUE)
55 cat("\t;\n", file = file, append = TRUE)
56 cat("END;\n", file = file, append = TRUE)
58 cat("BEGIN TREES;\n", file = file, append = TRUE)
60 ## We take arbitrarily the labels of the first tree, and
61 ## translate them as "1", "2", "3", ...
62 cat("\tTRANSLATE\n", file = file, append = TRUE)
63 tmp <- checkLabel(obj[[1]]$tip.label)
64 X <- paste("\t\t", 1:N, "\t", tmp, ",", sep = "")
65 ## We remove the last comma:
66 X[length(X)] <- gsub(",", "", X[length(X)])
67 cat(X, file = file, append = TRUE, sep = "\n")
68 cat("\t;\n", file = file, append = TRUE)
69 token <- as.character(1:N)
70 names(token) <- obj[[1]]$tip.label
71 obj[[1]]$tip.label <- token
74 obj[[i]]$tip.label <- token[obj[[i]]$tip.label]
77 obj[[i]]$tip.label <- checkLabel(obj[[i]]$tip.label)
80 if (class(obj[[i]]) != "phylo") next
81 if (is.rooted(obj[[i]]))
82 cat("\tTREE * UNTITLED = [&R] ", file = file, append = TRUE)
83 else cat("\tTREE * UNTITLED = [&U] ", file = file, append = TRUE)
84 cat(write.tree(obj[[i]], file = ""),
85 "\n", sep = "", file = file, append = TRUE)
87 cat("END;\n", file = file, append = TRUE)
88 if(original.data) cat(ORI, file = file, append = TRUE, sep = "\n")