R/me.R

   1 ## me.R (2009-01-07)
   2
   3 ##   Tree Estimation Based on Minimum Evolution Algorithm
   4
   5 ## Copyright 2007 Vincent Lefort with modifications by
   6 ##                 Emmanuel Paradis (2008-2009)
   7
   8 ## This file is part of the R-package `ape'.
   9 ## See the file ../COPYING for licensing issues.
  10
  11 fastme.bal <- function(X, nni = TRUE, spr = TRUE, tbr = TRUE)
  12 {
  13     if (is.matrix(X)) X <- as.dist(X)
  14     N <- as.integer(attr(X, "Size"))
  15     labels <- sprintf("%6s", 1:N)
  16     edge1 <- edge2 <- integer(2*N - 3)
  17
  18     ans <- .C("me_b", as.double(X), N, labels, as.integer(nni),
  19               as.integer(spr), as.integer(tbr), edge1, edge2,
  20               double(2*N - 3), character(N), PACKAGE = "ape")
  21
  22     labels <- substr(ans[[10]], 1, 6)
  23     LABS <- attr(X, "Labels")
  24     labels <- if (!is.null(LABS)) LABS[as.numeric(labels)]
  25     else gsub("^ ", "", labels)
  26     structure(list(edge =  cbind(ans[[7]], ans[[8]]), edge.length = ans[[9]],
  27                    tip.label = labels, Nnode = N - 2L),
  28               class = "phylo")
  29 }
  30
  31 fastme.ols <- function(X, nni = TRUE)
  32 {
  33     if (is.matrix(X)) X <- as.dist(X)
  34     N <- as.integer(attr(X, "Size"))
  35     labels <- sprintf("%6s", 1:N)
  36     edge1 <- edge2 <- integer(2*N - 3)
  37     ans <- .C("me_o", as.double(X), N, labels, as.integer(nni),
  38               edge1, edge2, double(2*N - 3), character(N),
  39               PACKAGE = "ape")
  40     labels <- substr(ans[[8]], 1, 6)
  41     LABS <- attr(X, "Labels")
  42     labels <- if (!is.null(LABS)) LABS[as.numeric(labels)]
  43     else gsub("^ ", "", labels)
  44     structure(list(edge =  cbind(ans[[5]], ans[[6]]), edge.length = ans[[7]],
  45                    tip.label = labels, Nnode = N - 2L),
  46               class = "phylo")
  47 }
  48
  49 bionj <- function(X)
  50 {
  51     if (is.matrix(X)) X <- as.dist(X)
  52     N <- as.integer(attr(X, "Size"))
  53     labels <- sprintf("%6s", 1:N)
  54     edge1 <- edge2 <- integer(2*N - 3)
  55     ans <- .C("bionj", as.double(X), N, labels, edge1, edge2,
  56               double(2*N - 3), character(N), PACKAGE = "ape")
  57     labels <- substr(ans[[7]], 1, 6)
  58     LABS <- attr(X, "Labels")
  59     labels <- if (!is.null(LABS)) LABS[as.numeric(labels)]
  60     else gsub("^ ", "", labels)
  61     structure(list(edge =  cbind(ans[[4]], ans[[5]]), edge.length = ans[[6]],
  62                    tip.label = labels, Nnode = N - 2L),
  63               class = "phylo")
  64 }