1 ## as.phylo.formula.R (2005-12-10)
3 ## Conversion from Taxonomy Variables to Phylogenetic Trees
5 ## Copyright 2005 Julien Dutheil
7 ## This file is part of the R-package `ape'.
8 ## See the file ../COPYING for licensing issues.
10 as.phylo.formula <- function(x, data=parent.frame(), ...)
12 # Testing formula syntax:
13 err <- "Formula must be of the kind \"~A1/A2/.../An\"."
14 if(length(x) != 2) stop(err)
15 if(x[[1]] != "~") stop(err)
18 while(length(f) == 3) {
19 if(f[[1]] != "/") stop(err)
20 if(!is.factor(data[[deparse(f[[3]])]])) stop(paste("Variable", deparse(f[[3]]), "must be a factor."))
21 taxo[[deparse(f[[3]])]] <- data[[deparse(f[[3]])]]
22 if(length(f) > 1) f <- f[[2]]
24 if(!is.factor(data[[deparse(f)]])) stop(paste("Variable", deparse(f), "must be a factor."))
25 taxo[[deparse(f)]] <- data[[deparse(f)]]
26 taxo.data <- as.data.frame(taxo)
27 leaves.names <- as.character(taxo.data[,1])
28 taxo.data[,1] <- 1:nrow(taxo.data)
29 # Now builds the phylogeny:
31 f.rec <- function(subtaxo) { # Recurrent utility function
33 levels <- unique(subtaxo[,u])
35 if(length(levels) != nrow(subtaxo))
36 warning("Error, leaves names are not unique.")
37 return(as.character(subtaxo[,1]))
39 t <- character(length(levels))
40 for(l in 1:length(levels)) {
41 x <- f.rec(subtaxo[subtaxo[,u] == levels[l],][1:(u-1)])
42 if(length(x) == 1) t[l] <- x
43 else t[l] <- paste("(", paste(x, collapse=","), ")", sep="")
47 string <- paste("(", paste(f.rec(taxo.data), collapse=","), ");", sep="")
48 phy<-read.tree(text=string)
49 phy$tip.label <- leaves.names[as.numeric(phy$tip.label)]