R/klastorin.R

   1 ## klastorin.R (2003-05-26)
   2
   3 ##   Klastorin's (1982) classifification method, applied to
   4 ##   phylogenetic trees as suggested by Misawa and Tajima (2000)
   5
   6 ## Copyright 2003 Gangolf Jobb
   7
   8 ## This file is part of the R-package `ape'.
   9 ## See the file ../COPYING for licensing issues.
  10
  11 ########### PRIVATE ##############
  12
  13 getMisawaTajima <- function()
  14   .C("getMisawaTajima", result = integer(klastorin_nTips()),
  15      PACKAGE = "ape")$result
  16
  17 ### functions to set and extract phylo tree ###
  18
  19 buildTreeFromPhylo <- function(tree) {
  20     lowerNodes <- tree$edge[,1]
  21     upperNodes <- tree$edge[,2]
  22     edgeLengths <- tree$edge.length
  23     tipLabels <- tree$tip.label
  24     .C("buildTreeFromPhylo", as.integer(lowerNodes),
  25        as.integer(upperNodes), as.double(edgeLengths),
  26        as.integer(length(edgeLengths)),
  27        as.character(tipLabels),
  28        as.integer(length(tipLabels)),
  29        result = integer(1), PACKAGE = "ape"
  30        )$result
  31 }
  32
  33 destroyTree <- function()
  34   .C("destroyTree", result = integer(1),
  35      PACKAGE = "ape")$result
  36
  37 getError <- function()
  38   .C("getError", result = integer(1),
  39      PACKAGE = "ape")$result
  40
  41 klastorin_nTips <- function()
  42   .C("nTips", result = integer(1),
  43      PACKAGE = "ape")$result
  44
  45 ########### PUBLIC ##############
  46
  47 klastorin <- function(phy)
  48 {
  49     if (!inherits(phy, "phylo"))
  50       stop("object \"phy\" is not of class \"phylo\"")
  51     ## added by EP for the new coding of "phylo" (2006-10-04):
  52     phy <- new2old.phylo(phy)
  53     ## End
  54     buildTreeFromPhylo(phy)
  55     if (getError() !=0) stop("Could not load \"phylo\" object")
  56     tmp <- getMisawaTajima()
  57     destroyTree()
  58     tmp
  59 }