X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=R%2Fbind.tree.R;h=b43ce900055d4c393e324023ab7ff57801a0afe8;hb=refs%2Fheads%2Fmaster;hp=b862b37db3d32a7f8848d07d54dbb48097042951;hpb=0875d81d5ba5e6dfe79d42c21b0284b674c73949;p=ape.git diff --git a/R/bind.tree.R b/R/bind.tree.R index b862b37..b43ce90 100644 --- a/R/bind.tree.R +++ b/R/bind.tree.R @@ -1,8 +1,8 @@ -## bind.tree.R (2010-05-25) +## bind.tree.R (2012-02-13) ## Bind Trees -## Copyright 2003-2010 Emmanuel Paradis +## Copyright 2003-2012 Emmanuel Paradis ## This file is part of the R-package `ape'. ## See the file ../COPYING for licensing issues. @@ -63,9 +63,11 @@ bind.tree <- function(x, y, where = "root", position = 0, interactive = FALSE) ## case = 3 -> y is bound on a node of x ## check that 'position' is correct - if (position) { - if (!wbl) - stop("'position' is non-null but trees have no branch lengths") + if (position && wbl) { +### New in ape 3.0-1: this makes possible binding 'y' below +### a node of 'x' thus creating a new node in 'x' +### if (!wbl) +### stop("'position' is non-null but trees have no branch lengths") if (case == 1) { if (xHasNoRootEdge) stop("tree 'x' has no root edge") @@ -77,7 +79,7 @@ bind.tree <- function(x, y, where = "root", position = 0, interactive = FALSE) } } - ## the special of substituting two tips: + ## the special case of substituting two tips: if (case == 2 && ny == 1 && !position) { x$tip.label[x$edge[i, 2]] <- y$tip.label if (wbl) @@ -88,14 +90,14 @@ bind.tree <- function(x, y, where = "root", position = 0, interactive = FALSE) x <- reorder(x) y <- reorder(y) -### because in all situations internal nodes need to be renumbered, -### they are changed to negatives first, and nodes that eventually -### will be added will be numbered sequentially +### because in all situations internal nodes need to be +### renumbered, they are changed to negatives first, and +### nodes eventually added will be numbered sequentially nodes <- x$edge > nx x$edge[nodes] <- -(x$edge[nodes] - nx) # -1, ..., -mx nodes <- y$edge > ny - y$edge[nodes] <- -(y$edge[nodes] - ny + mx) # -(mx+1), ..., -(mx+my) + y$edge[nodes] <- -(y$edge[nodes] - ny + mx) # -(mx+1), ..., -(mx+my) ROOT <- -1L # may change later next.node <- -(mx + my) - 1L @@ -146,8 +148,8 @@ bind.tree <- function(x, y, where = "root", position = 0, interactive = FALSE) y$edge[1] <- x$edge[i, 1] ## delete i-th edge in x: x$edge <- x$edge[-i, ] - i <- i - 1L if (wbl) x$edge.length <- x$edge.length[-i] + i <- i - 1L } x$tip.label <- x$tip.label[-where] ## renumber the tips that need to: @@ -198,19 +200,18 @@ bind.tree <- function(x, y, where = "root", position = 0, interactive = FALSE) ## update the node labels before renumbering (this adds NA for ## the added nodes, and drops the label for those deleted) if (!is.null(x$node.label)) - x$node.label <- x$node.label[-unique(x$edge[, 1])] + x$node.label <- x$node.label[sort(-unique(x$edge[, 1]))] ## renumber nodes: newNb <- integer(x$Nnode) newNb[-ROOT] <- n + 1L sndcol <- x$edge[, 2] < 0 ## executed from right to left, so newNb is modified before x$edge: - x$edge[sndcol, 2] <- newNb[-x$edge[sndcol, 2]] <- - (n + 2):(n + x$Nnode) + x$edge[sndcol, 2] <- newNb[-x$edge[sndcol, 2]] <- n + 2:x$Nnode x$edge[, 1] <- newNb[-x$edge[, 1]] if (!is.null(x$node.label)) - x$node.label <- x$node.label[newNb[newNb == 0] - n] + x$node.label <- x$node.label[order(newNb[newNb > 0])] x }