R/as.bitsplits.R

   1 ## as.bitsplits.R (2011-10-19)
   2
   3 ##   Conversion Among Split Classes
   4
   5 ## Copyright 2011 Emmanuel Paradis
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 as.bitsplits <- function(x) UseMethod("as.bitsplits")
  11
  12 as.bitsplits.prop.part <- function(x)
  13 {
  14     foo <- function(vect, RAWVECT) {
  15         res <- RAWVECT
  16         for (y in vect) {
  17             i <- ceiling(y/8)
  18             res[i] <- res[i] | as.raw(2^(8 - ((y - 1) %% 8) - 1))
  19         }
  20         res
  21     }
  22
  23     N <- length(x) # number of splits
  24     n <- length(x[[1]]) # number of tips
  25
  26     nr <- ceiling(n/8)
  27     mat <- raw(N * nr)
  28     dim(mat) <- c(nr, N)
  29
  30     RAWVECT <- raw(nr)
  31
  32     for (i in 1:N) mat[, i] <- foo(x[[i]], RAWVECT)
  33
  34     ## add the n trivial splits of size 1... :
  35     mat.bis <- raw(n * nr)
  36     dim(mat.bis) <- c(nr, n)
  37     for (i in 1:n) mat.bis[, i] <- foo(i, RAWVECT)
  38
  39     ## ... drop the trivial split of size n... :
  40     mat <- cbind(mat.bis, mat[, -1, drop = FALSE])
  41
  42     ## ... update the split frequencies... :
  43     freq <- attr(x, "number")
  44     freq <- c(rep(freq[1L], n), freq[-1L])
  45
  46     ## ... and numbers:
  47     N <- N + n - 1L
  48
  49     structure(list(matsplit = mat, labels = attr(x, "labels"),
  50                    freq =  freq), class = "bitsplits")
  51 }
  52
  53 print.bitsplits <- function(x, ...)
  54 {
  55     cat('Object of class "bitsplits"\n')
  56     cat('   ', length(x$labels), 'tips\n')
  57     cat('   ', length(x$freq), 'partitions\n\n')
  58 }