o reorder.phylo() has a new order, "postorder", and a new option
index.only = TRUE to return only the vector of indices (the tree
- is unmodified; see ?reorder.phylo for details).
+ is unmodified, see ?reorder.phylo for details).
+
+ o The three new functions node.depth.length, node.height, and
+ node.height.clado make some internal code available from R. See
+ ?node.depth (which was already available and documented) for
+ details.
BUG FIXES
o reorder(, "pruningwise") made R crash if the rows of the edge
- matrix are in random order.
+ matrix are in random order: this is now fixed.
OTHER CHANGES
visible for small trees (n < 1000) but this can be more than
1000 faster for big trees (n >= 1e4).
+ o The attribute "order" of the objects of class "phylo" is now
+ strongly recommended, though not mandatory. Most functions in
+ ape should return a tree with this attribute correctly set.
+
+ o dbd() is now vectorized on both arguments 'x' (number of species
+ in clade) and 't' (clade age) to make likelihood calculations
+ easier and faster.
+
CHANGES IN APE VERSION 3.0-5
-## CDF.birth.death.R (2010-09-27)
+## CDF.birth.death.R (2012-09-14)
-## Functions to simulate and fit
+## Functions to Simulate and Fit
## Time-Dependent Birth-Death Models
-## Copyright 2010 Emmanuel Paradis
+## Copyright 2010-2012 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
if (!case %in% c(1, 3, 6)) Pi <- Vectorize(Pi)
- denom <- if (fast) integrateTrapeze(Pi, 0, Tmax) else integrate(Pi, 0, Tmax)$value
+ denom <-
+ if (fast) integrateTrapeze(Pi, 0, Tmax)
+ else integrate(Pi, 0, Tmax)$value
n <- length(x)
p <- numeric(n)
if (fast) {
phy <- list(edge = edge, edge.length = edge.length,
tip.label = paste("t", 1:(i + 1), sep = ""), Nnode = i)
class(phy) <- "phylo"
+ attr(phy, "order") <- "cladewise"
phy
}
-## DNA.R (2012-06-19)
+## DNA.R (2012-09-13)
## Manipulations and Comparisons of DNA Sequences
{
if (is.list(x)) x <- unlist(x)
n <- length(x)
- BF <-.C("BaseProportion", x, n, double(17),
+ BF <-.C("BaseProportion", x, as.integer(n), double(17),
DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")[[3]]
names(BF) <- c("a", "c", "g", "t", "r", "m", "w", "s",
"k", "y", "v", "h", "d", "b", "n", "-", "?")
n <- n[1]
}
if (n == 1) return(integer(0))
- ans <- .C("SegSites", x, n, s, integer(s),
- DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")
+ ans <- .C("SegSites", x, as.integer(n), as.integer(s),
+ integer(s), DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")
which(as.logical(ans[[4]]))
}
var <- if (variance) double(Ndist) else 0
if (!gamma) gamma <- alpha <- 0
else alpha <- gamma <- 1
- d <- .C("dist_dna", x, n, s, imod, double(Ndist), BF,
- as.integer(pairwise.deletion), as.integer(variance),
- var, as.integer(gamma), alpha, DUP = FALSE, NAOK = TRUE,
- PACKAGE = "ape")
+ d <- .C("dist_dna", x, as.integer(n), as.integer(s), imod,
+ double(Ndist), BF, as.integer(pairwise.deletion),
+ as.integer(variance), var, as.integer(gamma),
+ alpha, DUP = FALSE, NAOK = TRUE, PACKAGE = "ape")
if (variance) var <- d[[9]]
d <- d[[5]]
if (imod == 11) {
-## dbd.R (2012-03-19)
+## dbd.R (2012-09-14)
## Probability Density Under Birth--Death Models
mu <- mu[1]
warning("only the first value of 'mu' was considered")
}
- if (length(t) > 1) {
- t <- t[1]
- warning("only the first value of 't' was considered")
- }
if (mu == 0) return(dyule(x, lambda, t, log))
-## evonet.R (2011-06-09)
+## evonet.R (2012-09-14)
## Evolutionary Networks
-## Copyright 2011 Emmanuel Paradis
+## Copyright 2011-2012 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
{
if (any(x$reticulation <= Ntip(x)))
stop("some tips are involved in reticulations: cannot convert to \"networx\"")
- x <- reorder(x, "p")
+ x <- reorder(x, "pruningwise")
ned <- Nedge(x)
nrt <- nrow(x$reticulation)
x$edge <- rbind(x$edge, x$reticulation)
start <- start[o]
neworder[newpos] <<- start
for (i in 1:Nclade)
- if (desc[i] > nb.tip) foo(desc[i], end[i], newpos[i] + 1)
+ if (desc[i] > nb.tip) foo(desc[i], end[i], newpos[i] + 1)
}
nb.tip <- length(phy$tip.label)
nb.node <- phy$Nnode
foo(nb.tip + 1, nb.edge, 1)
phy$edge <- phy$edge[neworder, ]
if (!is.null(phy$edge.length))
- phy$edge.length <- phy$edge.length[neworder]
+ phy$edge.length <- phy$edge.length[neworder]
phy
}
-## me.R (2012-04-30)
+## me.R (2012-09-14)
## Tree Estimation Based on Minimum Evolution Algorithm
labels <- attr(X, "Labels")
if (is.null(labels)) labels <- as.character(1:N)
labels <- labels[ans[[3]]]
- structure(list(edge = cbind(ans[[7]], ans[[8]]),
- edge.length = ans[[9]],
- tip.label = labels, Nnode = N - 2L),
- class = "phylo")
+ obj <- list(edge = cbind(ans[[7]], ans[[8]]),
+ edge.length = ans[[9]],
+ tip.label = labels, Nnode = N - 2L)
+ class(obj) <- "phylo"
+ attr(obj, "order") <- "cladewise"
+ obj
}
fastme.ols <- function(X, nni = TRUE)
labels <- attr(X, "Labels")
if (is.null(labels)) labels <- as.character(1:N)
labels <- labels[ans[[3]]]
- structure(list(edge = cbind(ans[[5]], ans[[6]]),
- edge.length = ans[[7]],
- tip.label = labels, Nnode = N - 2L),
- class = "phylo")
+ obj <- list(edge = cbind(ans[[5]], ans[[6]]),
+ edge.length = ans[[7]],
+ tip.label = labels, Nnode = N - 2L)
+ class(obj) <- "phylo"
+ attr(obj, "order") <- "cladewise"
+ obj
}
bionj <- function(X)
-## pic.R (2011-03-01)
+## pic.R (2012-09-11)
## Phylogenetically Independent Contrasts
-## Copyright 2002-2011 Emmanuel Paradis
+## Copyright 2002-2012 Emmanuel Paradis
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
if (any(is.na(x)))
stop("missing data in 'x': you may consider removing the species with missing data from your tree with the function 'drop.tip'.")
- phy <- reorder(phy, "pruningwise")
+ phy <- reorder(phy, "postorder")
phenotype <- numeric(nb.tip + nb.node)
if (is.null(names(x))) {
-## plot.phylo.R (2012-03-22)
+## plot.phylo.R (2012-10-02)
## Plot Phylogenies
as.integer(N), double(n + m), DUP = FALSE, PACKAGE = "ape")[[6]]
}
+node.depth.edgelength <- function(phy)
+{
+ n <- length(phy$tip.label)
+ m <- phy$Nnode
+ N <- dim(phy$edge)[1]
+ phy <- reorder(phy, order = "pruningwise")
+ .C("node_depth_edgelength", as.integer(n), as.integer(n),
+ as.integer(phy$edge[, 1]), as.integer(phy$edge[, 2]),
+ as.integer(N), as.double(phy$edge.length), double(n + m),
+ DUP = FALSE, PACKAGE = "ape")[[7]]
+}
+
+node.height <- function(phy)
+{
+ n <- length(phy$tip.label)
+ m <- phy$Nnode
+ N <- dim(phy$edge)[1]
+ phy <- reorder(phy, order = "pruningwise")
+
+ e1 <- phy$edge[, 1]
+ e2 <- phy$edge[, 2]
+
+ yy <- numeric(n + m)
+ TIPS <- e2[e2 <= n]
+ yy[TIPS] <- 1:n
+
+ .C("node_height", as.integer(n), as.integer(m),
+ as.integer(e1), as.integer(e2), as.integer(N),
+ as.double(yy), DUP = FALSE, PACKAGE = "ape")[[6]]
+}
+
+node.height.clado <- function(phy)
+{
+ n <- length(phy$tip.label)
+ m <- phy$Nnode
+ N <- dim(phy$edge)[1]
+ phy <- reorder(phy, order = "pruningwise")
+
+ e1 <- phy$edge[, 1]
+ e2 <- phy$edge[, 2]
+
+ yy <- numeric(n + m)
+ TIPS <- e2[e2 <= n]
+ yy[TIPS] <- 1:n
+
+ .C("node_height_clado", as.integer(n), as.integer(m),
+ as.integer(e1), as.integer(e2), as.integer(N),
+ double(n + m), as.double(yy), DUP = FALSE,
+ PACKAGE = "ape")[[7]]
+}
+
plot.multiPhylo <- function(x, layout = 1, ...)
{
if (layout > 1)
-## read.nexus.R (2012-02-09)
+## read.nexus.R (2012-09-28)
## Read Tree File in Nexus Format
names(phy) <- nms
if (all(phy$node.label == "")) phy$node.label <- NULL
class(phy) <- "phylo"
+ attr(phy, "order") <- "cladewise"
phy
}
if (all(obj$node.label == "NA")) NULL
else gsub("^NA", "", obj$node.label)
class(obj) <- "phylo"
+ attr(obj, "order") <- "cladewise"
obj
}
-## read.tree.R (2010-09-27)
+## read.tree.R (2012-09-14)
## Read Tree Files in Parenthetic Format
-## Copyright 2002-2010 Emmanuel Paradis, Daniel Lawson and Klaus Schliep
+## Copyright 2002-2012 Emmanuel Paradis, Daniel Lawson and Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
if (any(nzchar(node.label))) obj$node.label <- node.label
if (!is.na(root.edge)) obj$root.edge <- root.edge
class(obj) <- "phylo"
+ attr(obj, "order") <- "cladewise"
obj
}
-## rtree.R (2012-02-09)
+## rtree.R (2012-09-14)
## Generates Trees
}
phy$Nnode <- n - 2L + rooted
class(phy) <- "phylo"
+ attr(phy, "order") <- "cladewise"
phy
}
\alias{circular.plot}
\alias{unrooted.plot}
\alias{unrooted.xy}
-\alias{node.height}
-\alias{node.height.clado}
\alias{birth.step}
\alias{death.step}
\alias{ht.move}
\code{dbdTime} is for time-varying \code{lambda} and \code{mu}
specified as \R functions.
- Only \code{dyule} is vectorized simultaneously on its three arguments
+ \code{dyule} is vectorized simultaneously on its three arguments
\code{x}, \code{lambda}, and \code{t}, according to \R's rules of
- recycling arguments. The two others are vectorized only on \code{x};
- the other arguments are eventually shortened with a warning if
- necessary.
+ recycling arguments. \code{dbd} is vectorized simultaneously \code{x}
+ and \code{t} (to make likelihood calculations easy), and
+ \code{dbdTime} is vectorized only on \code{x}; the other arguments are
+ eventually shortened with a warning if necessary.
The returned value is, logically, zero for values of \code{x} out of
range, i.e., negative or zero for \code{dyule} or if \code{conditional
\name{node.depth}
\alias{node.depth}
-\title{Depth of Nodes and Tips}
+\alias{node.depth.length}
+\alias{node.height}
+\alias{node.height.clado}
+\title{Depth and Heights of Nodes and Tips}
\description{
- This function returns the depth of nodes and tips given by the number
- of descendants (1 is returned for tips).
+ These functions return the depth or height of nodes and tips.
}
\usage{
node.depth(phy)
+node.depth.length(phy)
+node.height(phy)
+node.height.clado(phy)
}
\arguments{
\item{phy}{an object of class "phylo".}
}
\details{
- The depth of a node is computed as the number of tips which are its
- descendants. The value of 1 is given to the tips.
+ \code{node.depth} computes the depth of a node as the number of tips
+ which are its descendants. The value of 1 is given to the tips.
+
+ \code{node.depth.length} does the same but using branch lengths.
+
+ \code{node.height} computes the heights of nodes and tips as plotted
+ by a phylogram.
+
+ \code{node.height.clado} does the same but for a cladogram.
}
\value{
A numeric vector indexed with the node numbers of the matrix `edge' of
data(bird.orders)
rTraitCont(bird.orders) # BM with sigma = 0.1
### OU model with two optima:
-tr <- reorder(bird.orders, "p")
+tr <- reorder(bird.orders, "postorder")
plot(tr)
edgelabels()
theta <- rep(0, Nedge(tr))
-/* plot_phylo.c (2011-06-23) */
+/* plot_phylo.c (2012-10-01) */
-/* Copyright 2004-2011 Emmanuel Paradis
+/* Copyright 2004-2012 Emmanuel Paradis
/* This file is part of the R-package `ape'. */
/* See the file ../COPYING for licensing issues. */
}
void node_height(int *ntip, int *nnode, int *edge1, int *edge2,
- int *nedge, double *yy)
+ int *nedge, double *yy)
{
int i, n;
double S;
}
}
}
-
-void get_single_index_integer(int *x, int *val, int *index)
-{
- while (x[*index] != *val) (*index)++;
- *index += 1;
-}
-
-void get_two_index_integer(int *x, int *val, int *index)
-{
- while (x[index[0]] != *val) index[0]++;
- index[1] = index[0] + 1;
- while (x[index[1]] != *val) index[1]++;
- index[0] += 1;
- index[1] += 1;
-}
projects / ape.git / commitdiff