- if (!check.labels) {
- for (i in 1:ntree) storage.mode(obj[[i]]$Nnode) <- "integer"
- clades <- .Call("prop_part", obj, ntree, TRUE, PACKAGE = "ape")
- attr(clades, "number") <- attr(clades, "number")[1:length(clades)]
- attr(clades, "labels") <- obj[[1]]$tip.label
- } else {
- bp <- .Call("bipartition", obj[[1]]$edge, length(obj[[1]]$tip.label),
- obj[[1]]$Nnode, PACKAGE = "ape")
- clades <- lapply(bp, function(xx) sort(obj[[1]]$tip.label[xx]))
- no <- rep(1, length(clades))
-
- if (ntree > 1) {
- for (k in 2:ntree) {
- bp <- .Call("bipartition", obj[[k]]$edge,
- length(obj[[k]]$tip.label), obj[[k]]$Nnode,
- PACKAGE = "ape")
- bp <- lapply(bp, function(xx) sort(obj[[k]]$tip.label[xx]))
- for (i in 1:length(bp)) {
- done <- FALSE
- for (j in 1:length(clades)) {
- if (identical(all.equal(bp[[i]], clades[[j]]), TRUE)) {
- no[j] <- no[j] + 1
- done <- TRUE
- break
- }
- }
- if (!done) {
- clades <- c(clades, bp[i])
- no <- c(no, 1)
- }
- }
- }
- }
- attr(clades, "number") <- no
- }
+ if (ntree == 1) check.labels <- FALSE
+ if (check.labels) obj <- .compressTipLabel(obj)
+ for (i in 1:ntree) storage.mode(obj[[i]]$Nnode) <- "integer"
+ ## <FIXME>
+ ## The 1st must have tip labels
+ ## Maybe simply pass the number of tips to the C code??
+ if (!is.null(attr(obj, "TipLabel")))
+ for (i in 1:ntree) obj[[i]]$tip.label <- attr(obj, "TipLabel")
+ ## </FIXME>
+ clades <- .Call("prop_part", obj, ntree, TRUE, PACKAGE = "ape")
+ attr(clades, "number") <- attr(clades, "number")[1:length(clades)]
+ attr(clades, "labels") <- obj[[1]]$tip.label