+ as.Splits.integer() (#232)

Author: ms609

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: TreeTools
 Title: Create, Modify and Analyse Phylogenetic Trees
-Version: 1.16.1.9000
+Version: 1.16.1.9001
 Authors@R: c(
   person("Martin R.", 'Smith', role = c("aut", "cre", "cph"), 
          email = "martin.smith@durham.ac.uk",

NAMESPACE

@@ -197,10 +197,12 @@ S3method(as.Newick,multiPhylo)
 S3method(as.Newick,phylo)
 S3method(as.Splits,Splits)
 S3method(as.Splits,character)
+S3method(as.Splits,integer)
 S3method(as.Splits,list)
 S3method(as.Splits,logical)
 S3method(as.Splits,matrix)
 S3method(as.Splits,multiPhylo)
+S3method(as.Splits,numeric)
 S3method(as.Splits,phylo)
 S3method(as.TreeNumber,MixedBase)
 S3method(as.TreeNumber,TreeNumber)

NEWS.md

@@ -1,5 +1,6 @@
-# TreeTools 1.16.1.9000 (development) #
+# TreeTools 1.16.1.9001` (development) #
 
+- New method `as.Splits.integer()`.
 - Fix `RoguePlot(sort = TRUE)`
   [Rogue#33](https://github.com/ms609/Rogue/issues/33).
 

R/Splits.R

@@ -7,9 +7,12 @@ setClass("Splits", representation("raw"))
 #' its constituent bipartition splits.
 #'
 #' @param x Object to convert into splits: perhaps a tree of class
-#'  \code{\link[ape:read.tree]{phylo}}.
-#'  If a logical matrix is provided, each row will be considered as a
-#'  separate split.
+#' \code{\link[ape:read.tree]{phylo}}.
+#' If a logical matrix is provided, each row will be considered as a separate
+#' split.
+#' If an integer matrix is provided, entries assigned the same integer will
+#' be assigned to the same split.
+#'  
 #' @param tipLabels Character vector specifying sequence in which to order
 #' tip labels.  Label order must (currently) match to combine or compare separate
 #' `Splits` objects.
@@ -212,6 +215,28 @@ as.Splits.matrix <- function(x, tipLabels = NULL, ...) {
   }
 }
 
+#' @rdname Splits
+#' @export
+as.Splits.integer <- function(x, tipLabels = NULL, ...) {
+  membership <- t(vapply(sort(unique(x)), `==`, logical(length(x)), x))
+  if (dim(membership)[[1]] == 2) {
+    as.Splits.logical(membership[1, ])
+  } else {
+    as.Splits.logical(membership)
+  }
+}
+
+#' @rdname Splits
+#' @export
+as.Splits.numeric <- function(x, tipLabels = NULL, ...) {
+  if (all(x == as.integer(x))) {
+    as.Splits.integer(as.integer(x))
+  } else {
+    stop("no applicable method for 'as.Splits' applied to an object of class \"",
+         class(x), "\"")
+  }
+}
+
 #' @rdname Splits
 #' @export
 as.Splits.logical <- function(x, tipLabels = NULL, ...) {

man/Splits.Rd

@@ -172,7 +172,6 @@ test_that("as.Splits.Splits()", {
 })
 
 test_that("as.Splits.matrix()", {
-  expect_error(as.Splits(matrix(1, 3, 3)))
   expect_error(as.Splits(matrix(1, 2, 2,
                                 dimnames = list(c("edge", "Nnode"), NULL))))
   trees <- list(BalancedTree(8), PectinateTree(8),
@@ -241,6 +240,26 @@ test_that("as.Splits.logical()", {
   expect_splits_equal(as.Splits(FFTT), as.Splits(t(matrix(FFTT))))
 })
 
+test_that("as.Splits.integer()", {
+  . <- FALSE
+  X <- TRUE
+  expect_splits_equal(as.Splits(c(rep(1L, 4))),
+                      as.Splits(c(., ., ., .)))
+  expect_splits_equal(as.Splits(c(rep(1L, 4), rep(2L, 4))),
+                      as.Splits(c(., ., ., ., X, X, X, X)))
+  expect_splits_equal(as.Splits(c(rep(1L, 4), rep(2L, 4), 3L)),
+                      as.Splits(rbind(c(X, X, X, X, ., ., ., ., .),
+                                      c(., ., ., ., X, X, X, X, .),
+                                      c(., ., ., ., ., ., ., ., X))))
+  expect_splits_equal(as.Splits(c(rep(33, 4), 0, rep(-1, 3), 0)),
+                      as.Splits(rbind(c(., ., ., ., ., X, X, X, .),
+                                      c(., ., ., ., X, ., ., ., X),
+                                      c(X, X, X, X, ., ., ., ., .))))
+  expect_error(as.Splits(c(rep(1.45, 4), rep(sqrt(2), 3))), 
+               "no applicable method")
+})
+
+
 test_that("as.Splits.character()", {
   a..f <- letters[1:6]
   a..i <- letters[1:9]