1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
## 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)
}
|
