remove duplicate function checkLabels (--> relabel)

R/addConfidences.R

@@ -94,12 +94,13 @@ addConfidences.splits <- function(x, y, scaler = 1, rooted=FALSE, ...) {
   nTips <- length(tiplabel)
   #    x = addTrivialSplits(x)
   if (inherits(y, "phylo")) {
-    ind <- match(tiplabel, y$tip.label)
-    if (any(is.na(ind)) | length(tiplabel) != length(y$tip.label))
-      stop("trees have different labels")
-    y$tip.label <- y$tip.label[ind]
-    ind2 <- match(seq_along(ind), y$edge[, 2])
-    y$edge[ind2, 2] <- order(ind)
+    y <- relabel(y, tiplabel)
+#    ind <- match(tiplabel, y$tip.label)
+#    if (any(is.na(ind)) | length(tiplabel) != length(y$tip.label))
+#      stop("trees have different labels")
+#    y$tip.label <- y$tip.label[ind]
+#    ind2 <- match(seq_along(ind), y$edge[, 2])
+#    y$edge[ind2, 2] <- order(ind)
   }
   if (inherits(y, "multiPhylo")) {
     if (inherits(try(.compressTipLabel(y), TRUE), "try-error")) {

R/bootstrap.R

@@ -208,18 +208,6 @@ bootstrap.phyDat <- function(x, FUN, bs = 100, multicore = FALSE,
 }
 
 
-checkLabels <- function(tree, tip) {
-  ind <- match(tree$tip.label, tip)
-  if (any(is.na(ind)) | length(tree$tip.label) != length(tip)) {
-    stop("tree has different labels")
-  }
-  tree$tip.label <- tip #tree$tip.label[ind]
-  ind2 <- tree$edge[, 2] <= Ntip(tree)
-  tree$edge[ind2, 2] <- ind[tree$edge[ind2, 2]]
-  tree
-}
-
-
 cladeMatrix <- function(x, rooted = FALSE) {
   if (!rooted) x <- unroot(x)
   pp <- prop.part(x)

R/fitch64.R

@@ -89,7 +89,7 @@ random.addition <- function (data, tree=NULL, method = "fitch")
     tree$edge <- edge
     remaining <- sample(setdiff(label, tree$tip.label))
     tree$tip.label <- c(tree$tip.label, remaining)
-    tree <- checkLabels(tree, label)
+    tree <- relabel(tree, label)
     remaining <- match(remaining, label)
   }
 

R/maxCladeCred.R

@@ -89,7 +89,7 @@ maxCladeCred <- function(x, tree = TRUE, part = NULL, rooted = TRUE) {
   l <- length(x)
   res <- numeric(l)
   for (i in 1:l) {
-    tmp <- checkLabels(x[[i]], pplabel)
+    tmp <- relabel(x[[i]], pplabel)
     if (!rooted) tmp <- unroot(tmp)
     ppi <- prop.part(tmp) # trees[[i]]
     if (!rooted) ppi <- SHORTwise(ppi)

R/treeManipulation.R

@@ -851,20 +851,33 @@ mrca2 <- function(phy, full = FALSE) {
 
 #' @rdname phangorn-internal
 #' @export
-relabel <- function(y, ref) {
-  label <- y$tip.label
-  if (identical(label, ref)) return(y)
-  if (length(label) != length(ref))
-    stop("one tree has a different number of tips")
+relabel <- function(x, ref) {
+  label <- x$tip.label
+  if (identical(label, ref)) return(x)
   ilab <- match(label, ref)
-  if (any(is.na(ilab)))
-    stop("one tree has different tip labels")
-  ie <- match(seq_along(ref), y$edge[, 2])
-  y$edge[ie, 2] <- ilab
-  y$tip.label <- ref
-  y
+  if (anyNA(ilab) | length(label) != length(ref))
+    stop("tree has different labels")
+  ie <- match(seq_along(ref), x$edge[, 2])
+  x$edge[ie, 2] <- ilab
+  x$tip.label <- ref
+  x
 }
 
+
+#checkLabels <- function(tree, tip) {
+#  ind <- match(tree$tip.label, tip)
+#  if (any(is.na(ind)) | length(tree$tip.label) != length(tip)) {
+#    stop("tree has different labels")
+#  }
+#  tree$tip.label <- tip
+#  ind2 <- tree$edge[, 2] <= Ntip(tree)
+#  tree$edge[ind2, 2] <- ind[tree$edge[ind2, 2]]
+#  tree
+#}
+
+
+
+
 #' @rdname midpoint
 #' @param labels tip and node labels to keep as tip labels in the tree
 #' @export

R/treedist.R

@@ -166,7 +166,7 @@ treedist <- function(tree1, tree2, check.labels = TRUE) {
 
   tree1 <- unroot(tree1)
   tree2 <- unroot(tree2)
-  if (check.labels) tree2 <- checkLabels(tree2, tree1$tip.label)
+  if (check.labels) tree2 <- relabel(tree2, tree1$tip.label)
 
   tree1 <- reorder(tree1, "postorder")
   tree2 <- reorder(tree2, "postorder")
@@ -313,7 +313,7 @@ SPR1 <- function(trees) {
 
 SPR2 <- function(tree, trees) {
   trees <- .compressTipLabel(trees)
-  tree <- checkLabels(tree, attr(trees, "TipLabel"))
+  tree <- relabel(tree, attr(trees, "TipLabel"))
   trees <- .uncompressTipLabel(trees)
   if (any(is.rooted(trees))) {
     trees <- unroot(trees)
@@ -374,7 +374,7 @@ wRF0 <- function(tree1, tree2, normalize = FALSE, check.labels = TRUE,
   }
   if (!is.binary(tree1) | !is.binary(tree2))
     message("Some trees are not binary. Result may not what you expect!")
-  if (check.labels) tree2 <- checkLabels(tree2, tree1$tip.label)
+  if (check.labels) tree2 <- relabel(tree2, tree1$tip.label)
   if (has.singles(tree1)) tree1 <- collapse.singles(tree1)
   if (has.singles(tree2)) tree2 <- collapse.singles(tree2)
 
@@ -404,7 +404,7 @@ wRF2 <- function(tree, trees, normalize = FALSE, check.labels = TRUE,
                  rooted = FALSE) {
   if (check.labels) {
     trees <- .compressTipLabel(trees)
-    tree <- checkLabels(tree, attr(trees, "TipLabel"))
+    tree <- relabel(tree, attr(trees, "TipLabel"))
   }
   trees <- .uncompressTipLabel(trees)
 
@@ -512,7 +512,7 @@ mRF2 <- function(tree, trees, normalize = FALSE, check.labels = TRUE,
                  rooted = FALSE) {
   trees <- .compressTipLabel(trees)
   tipLabel <- attr(trees, "TipLabel")
-  if (check.labels) tree <- checkLabels(tree, tipLabel)
+  if (check.labels) tree <- relabel(tree, tipLabel)
   nTips <- length(tipLabel)
   l <- length(trees)
   RF <- numeric(l)
@@ -627,7 +627,7 @@ RF0 <- function(tree1, tree2 = NULL, normalize = FALSE, check.labels = TRUE,
       r1 <- r2 <- FALSE
     }
   }
-  if (check.labels) tree2 <- checkLabels(tree2, tree1$tip.label)
+  if (check.labels) tree2 <- relabel(tree2, tree1$tip.label)
   if (!is.binary(tree1) | !is.binary(tree2))
     message("Some trees are not binary. Result may not what you expect!")
   bp1 <- bipart(tree1)
@@ -677,7 +677,7 @@ wRF.dist <- function(tree1, tree2 = NULL, normalize = FALSE,
 
 
 kf0 <- function(tree1, tree2, check.labels = TRUE, rooted = FALSE) {
-  if (check.labels) tree2 <- checkLabels(tree2, tree1$tip.label)
+  if (check.labels) tree2 <- relabel(tree2, tree1$tip.label)
   if (has.singles(tree1)) tree1 <- collapse.singles(tree1)
   if (has.singles(tree2)) tree2 <- collapse.singles(tree2)
   r1 <- is.rooted(tree1)
@@ -718,7 +718,7 @@ kf0 <- function(tree1, tree2, check.labels = TRUE, rooted = FALSE) {
 kf1 <- function(tree, trees, check.labels = TRUE, rooted = FALSE) {
   if (check.labels) {
     trees <- .compressTipLabel(trees)
-    tree <- checkLabels(tree, attr(trees, "TipLabel"))
+    tree <- relabel(tree, attr(trees, "TipLabel"))
   }
   trees <- .uncompressTipLabel(trees)
   if (any(has.singles(trees))) trees <- lapply(trees, collapse.singles)
@@ -843,7 +843,7 @@ path.dist <- function(tree1, tree2 = NULL, check.labels = TRUE,
 
 
 pd0 <- function(tree1, tree2, check.labels = TRUE, path = TRUE) {
-  if (check.labels) tree2 <- checkLabels(tree2, tree1$tip.label)
+  if (check.labels) tree2 <- relabel(tree2, tree1$tip.label)
   if (path) {
     tree1 <- unroot(tree1)
     tree2 <- unroot(tree2)
@@ -857,7 +857,7 @@ pd0 <- function(tree1, tree2, check.labels = TRUE, path = TRUE) {
 pd1 <- function(tree, trees, check.labels = TRUE, path = TRUE) {
   if (check.labels) {
     trees <- .compressTipLabel(trees)
-    tree <- checkLabels(tree, attr(trees, "TipLabel"))
+    tree <- relabel(tree, attr(trees, "TipLabel"))
   }
   trees <- .uncompressTipLabel(trees)
   if (path) {