Nothing
## as.bitsplits.R (2024-01-13)
## Conversion Among Split Classes
## Copyright 2011-2024 Emmanuel Paradis, 2019 Klaus Schliep
## This file is part of the R-package `ape'.
## See the file ../COPYING for licensing issues.
as.bitsplits <- function(x) UseMethod("as.bitsplits")
as.bitsplits.prop.part <- function(x)
{
foo <- function(vect, RAWVECT) {
res <- RAWVECT
for (y in vect) {
i <- ceiling(y/8)
res[i] <- res[i] | as.raw(2^(8 - ((y - 1) %% 8) - 1))
}
res
}
N <- length(x) # number of splits
n <- length(x[[1]]) # number of tips
nr <- ceiling(n/8)
mat <- raw(N * nr)
dim(mat) <- c(nr, N)
RAWVECT <- raw(nr)
for (i in 1:N) mat[, i] <- foo(x[[i]], RAWVECT)
## add the n trivial splits of size 1... :
mat.bis <- raw(n * nr)
dim(mat.bis) <- c(nr, n)
for (i in 1:n) mat.bis[, i] <- foo(i, RAWVECT)
## ... drop the trivial split of size n... :
mat <- cbind(mat.bis, mat[, -1, drop = FALSE])
## ... update the split frequencies... :
freq <- attr(x, "number")
freq <- c(rep(freq[1L], n), freq[-1L])
## ... and numbers:
N <- N + n - 1L
structure(list(matsplit = mat, labels = attr(x, "labels"),
freq = freq), class = "bitsplits")
}
print.bitsplits <- function(x, ...)
{
n <- length(x$freq)
cat("Object of class \"bitsplits\"\n")
cat(" ", length(x$labels), "tips\n")
cat(" ", n, "partition")
if (n > 1) cat("s")
cat("\n")
}
sort.bitsplits <- function(x, decreasing = FALSE, ...)
{
o <- order(x$freq, decreasing = decreasing)
x$matsplit <- x$matsplit[, o]
x$freq <- x$freq[o]
x
}
as.prop.part <- function(x, ...) UseMethod("as.prop.part")
as.prop.part.bitsplits <- function(x, include.trivial = FALSE, ...)
{
decodeBitsplits <- function(x) {
f <- function(y) rev(rawToBits(y)) == as.raw(1)
which(unlist(lapply(x, f)))
}
N <- ncol(x$matsplit) # nb of splits
n <- length(x$labels) # nb of tips
Nres <- if (include.trivial) N + 1L else N
res <- vector("list", Nres)
if (include.trivial) res[[1]] <- 1:n
j <- if (include.trivial) 2L else 1L
for (i in 1:N) {
res[[j]] <- decodeBitsplits(x$matsplit[, i])
j <- j + 1L
}
attr(res, "number") <- if (include.trivial) c(N, x$freq) else x$freq
attr(res, "labels") <- x$labels
class(res) <- "prop.part"
res
}
bitsplits <- function(x)
{
if (inherits(x, "phylo")) {
x <- list(x)
class(x) <- "multiPhylo"
} else {
if (!inherits(x, "multiPhylo"))
stop('x is not of class "phylo" or "multiPhylo"')
}
if (any(is.rooted(x)))
stop("bitsplits() accepts only unrooted trees")
x <- .compressTipLabel(x)
labs <- attr(x, "TipLabel")
n <- length(labs)
if (n > 46341)
warning("Tree(s) with more than 46,341 tips: this is likely too large.")
nr <- ceiling(n/8)
ans <- .Call(bitsplits_multiPhylo, x, n, nr)
nc <- ans[[3]]
if (nc) {
o <- ans[[1]][1:(nr * nc)]
freq <- ans[[2]][1:nc]
} else {
o <- raw()
freq <- integer()
}
dim(o) <- c(nr, nc)
structure(list(matsplit = o, labels = labs, freq = freq),
class = "bitsplits")
}
countBipartitions <- function(phy, X)
{
split <- bitsplits(phy)
SPLIT <- bitsplits(X)
.Call("CountBipartitionsFromSplits", split, SPLIT)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.