R/as.matching.R

   1 ## as.matching.R (2010-09-29)
   2
   3 ##    Conversion Between Phylo and Matching Objects
   4
   5 ## Copyright 2005-2010 Emmanuel Paradis
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 as.matching <- function(x, ...) UseMethod("as.matching")
  11
  12 as.matching.phylo <- function(x, labels = TRUE, ...)
  13 {
  14     nb.tip <- length(x$tip.label)
  15     nb.node <- x$Nnode
  16     if (nb.tip != nb.node + 1)
  17       stop("the tree must be dichotomous AND rooted.")
  18     x <- reorder(x, "pruningwise")
  19     mat <- matrix(x$edge[, 2], ncol = 2, byrow = TRUE)
  20     nodes <- x$edge[seq(by = 2, length.out = nb.node), 1]
  21     ## we can use match() becoz each node appears once in `mat'
  22     O <- match(mat, nodes)
  23     new.nodes <- 1:nb.node + nb.tip
  24     sel <- !is.na(O)
  25     mat[sel] <- new.nodes[O[sel]]
  26     mat <- cbind(t(apply(mat, 1, sort)), new.nodes, deparse.level = 0)
  27
  28     obj <- list(matching = mat)
  29     if (!is.null(x$edge.length))
  30         warning("branch lengths have been ignored")
  31     if (labels) {
  32         obj$tip.label <- x$tip.label
  33         if (!is.null(x$node.label))
  34           obj$node.label <- x$node.label[match(new.nodes, nodes)]
  35     }
  36     class(obj) <- "matching"
  37     obj
  38 }
  39
  40 as.phylo.matching <- function(x, ...)
  41 {
  42     N <- 2*dim(x$matching)[1]
  43     edge <- matrix(NA, N, 2)
  44     nb.tip <- (N + 2)/2
  45     nb.node <- nb.tip - 1
  46     new.nodes <- numeric(N + 1)
  47     new.nodes[N + 1] <- nb.tip + 1
  48     nextnode <- nb.tip + 2
  49     j <- 1
  50     for (i in nb.node:1) {
  51         edge[j:(j + 1), 1] <- new.nodes[x$matching[i, 3]]
  52         for (k in 1:2) {
  53             if (x$matching[i, k] > nb.tip) {
  54                 edge[j + k - 1, 2] <- new.nodes[x$matching[i, k]] <- nextnode
  55                 nextnode <- nextnode + 1
  56             } else edge[j + k - 1, 2] <- x$matching[i, k]
  57         }
  58         j <- j + 2
  59     }
  60     obj <- list(edge = edge)
  61     if (!is.null(x$tip.label)) obj$tip.label <- x$tip.label
  62     else obj$tip.label <- as.character(1:nb.tip)
  63     obj$Nnode <- nb.node
  64     class(obj) <- "phylo"
  65     read.tree(text = write.tree(obj))
  66 }