R/coalescent.intervals.R

   1 ## coalescent.intervals.R (2002-09-12)
   2
   3 ##   Constructs objects with information on coalescent intervals
   4
   5 ## Copyright 2002 Korbinian Strimmer
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 coalescent.intervals <- function(x) UseMethod("coalescent.intervals")
  11
  12 # set up coalescent interval object (from NH tree)
  13 coalescent.intervals.phylo <- function(x)
  14 {
  15     if (class(x) != "phylo") stop("object \"x\" is not of class \"phylo\"")
  16
  17     # ensure we have a BINARY tree
  18     if (!is.binary.tree(x)) stop("object \"x\" is not a binary tree")
  19     # ordered branching times
  20     t <- sort(branching.times(x))
  21     lt <- length(t)
  22
  23     # interval widths
  24     w <- numeric(lt)
  25     w[1] <- t[1]
  26     for (i in 2:lt) w[i] <- t[i] - t[i - 1]
  27
  28     l <- (lt+1):2       # number of lineages
  29
  30     obj <- list(
  31      lineages=l,
  32      interval.length=w,
  33      interval.count=lt,
  34      total.depth =sum(w))
  35     class(obj) <- "coalescentIntervals"
  36     return(obj)
  37 }
  38
  39
  40 # set up coalescent interval object from vector of interval length
  41 coalescent.intervals.default <- function(x)
  42 {
  43   if (!is.vector(x)) stop("argument \"x\" is not a vector of interval lengths")
  44
  45   # x = list of the widths of each interval
  46   lt <- length(x)
  47   l <- (lt+1):2           # number of lineages at the beginning of each interval
  48
  49   obj <- list(
  50      lineages=l,
  51      interval.length=x,
  52      interval.count=lt,
  53      total.depth =sum(x))
  54     class(obj) <- "coalescentIntervals"
  55     return(obj)
  56 }