Skip to content

Commit

Permalink
Don't remove node order info when reqd
Browse files Browse the repository at this point in the history
  • Loading branch information
ms609 committed Jul 25, 2024
1 parent dab4f75 commit ceef251
Show file tree
Hide file tree
Showing 6 changed files with 57 additions and 6 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@ Imports:
Rdpack (>= 0.7),
shiny,
shinyjs,
TreeTools (> 1.10.0),
TreeTools (>= 1.11.1.9004),
Suggests:
bookdown,
cluster,
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -151,6 +151,7 @@ importFrom(TreeTools,SplitInformation)
importFrom(TreeTools,SplitsInBinaryTree)
importFrom(TreeTools,TipLabels)
importFrom(TreeTools,TipsInSplits)
importFrom(TreeTools,TopologyOnly)
importFrom(TreeTools,TreeIsRooted)
importFrom(TreeTools,TreesMatchingSplit)
importFrom(TreeTools,as.ClusterTable)
Expand Down
26 changes: 26 additions & 0 deletions R/tree_distance_info.R
Original file line number Diff line number Diff line change
Expand Up @@ -203,9 +203,16 @@ TreeDistance <- function(tree1, tree2 = NULL) {
}

#' @rdname TreeDistance
#' @importFrom TreeTools TopologyOnly
#' @export
SharedPhylogeneticInfo <- function(tree1, tree2 = NULL, normalize = FALSE,
reportMatching = FALSE, diag = TRUE) {
if (!isTRUE(reportMatching)) {
# Remove unnecessary metadata that will slow calculations
tree1 <- TopologyOnly(tree1)
tree2 <- TopologyOnly(tree2)
}

unnormalized <- CalculateTreeDistance(SharedPhylogeneticInfoSplits, tree1,
tree2, reportMatching = reportMatching)

Expand All @@ -224,6 +231,12 @@ SharedPhylogeneticInfo <- function(tree1, tree2 = NULL, normalize = FALSE,
#' @export
DifferentPhylogeneticInfo <- function(tree1, tree2 = NULL, normalize = FALSE,
reportMatching = FALSE) {
if (!isTRUE(reportMatching)) {
# Remove unnecessary metadata that will slow calculations
tree1 <- TopologyOnly(tree1)
tree2 <- TopologyOnly(tree2)
}

spi <- SharedPhylogeneticInfo(tree1, tree2, normalize = FALSE, diag = FALSE,
reportMatching = reportMatching)
treesIndependentInfo <- .MaxValue(tree1, tree2, SplitwiseInfo)
Expand All @@ -249,6 +262,12 @@ PhylogeneticInfoDistance <- DifferentPhylogeneticInfo
#' @export
ClusteringInfoDistance <- function(tree1, tree2 = NULL, normalize = FALSE,
reportMatching = FALSE) {
if (!isTRUE(reportMatching)) {
# Remove unnecessary metadata that will slow calculations
tree1 <- TopologyOnly(tree1)
tree2 <- TopologyOnly(tree2)
}

mci <- MutualClusteringInfo(tree1, tree2, normalize = FALSE, diag = FALSE,
reportMatching = reportMatching)
treesIndependentInfo <- .MaxValue(tree1, tree2, ClusteringEntropy)
Expand Down Expand Up @@ -315,9 +334,16 @@ ExpectedVariation <- function(tree1, tree2, samples = 1e+4) {

#' @rdname TreeDistance
#' @aliases MutualClusteringInformation
#' @importFrom TreeTools TopologyOnly
#' @export
MutualClusteringInfo <- function(tree1, tree2 = NULL, normalize = FALSE,
reportMatching = FALSE, diag = TRUE) {
if (!reportMatching) {
# Remove unnecessary metadata that will slow calculations
tree1 <- TopologyOnly(tree1)
tree2 <- TopologyOnly(tree2)
}

unnormalized <- CalculateTreeDistance(Func = MutualClusteringInfoSplits,
tree1, tree2, reportMatching)
if (diag && is.null(tree2)) {
Expand Down
14 changes: 12 additions & 2 deletions R/tree_distance_nye.R
Original file line number Diff line number Diff line change
Expand Up @@ -64,13 +64,18 @@
#' @family tree distances
#'
#' @encoding UTF-8
#' @importFrom TreeTools NSplits SplitsInBinaryTree
#' @importFrom TreeTools NSplits SplitsInBinaryTree TopologyOnly
#' @export
NyeSimilarity <- function(tree1, tree2 = NULL, similarity = TRUE,
normalize = FALSE,
normalizeMax = !is.logical(normalize),
reportMatching = FALSE,
diag = TRUE) {
if (!isTRUE(reportMatching)) {
# Remove unnecessary metadata that will slow calculations
tree1 <- TopologyOnly(tree1)
tree2 <- TopologyOnly(tree2)
}

unnormalized <- CalculateTreeDistance(NyeSplitSimilarity, tree1, tree2,
reportMatching)
Expand Down Expand Up @@ -179,11 +184,16 @@ NyeSplitSimilarity <- function(splits1, splits2,
#' @family tree distances
#'
#' @encoding UTF-8
#' @importFrom TreeTools NSplits
#' @importFrom TreeTools NSplits TopologyOnly
#' @export
JaccardRobinsonFoulds <- function(tree1, tree2 = NULL, k = 1L,
allowConflict = TRUE, similarity = FALSE,
normalize = FALSE, reportMatching = FALSE) {
if (!isTRUE(reportMatching)) {
# Remove unnecessary metadata that will slow calculations
tree1 <- TopologyOnly(tree1)
tree2 <- TopologyOnly(tree2)
}
unnormalized <- CalculateTreeDistance(JaccardSplitSimilarity, tree1, tree2,
k = k, allowConflict = allowConflict,
reportMatching = reportMatching) * 2L
Expand Down
14 changes: 13 additions & 1 deletion R/tree_distance_rf.R
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,12 @@
#' @rdname Robinson-Foulds
InfoRobinsonFoulds <- function(tree1, tree2 = NULL, similarity = FALSE,
normalize = FALSE, reportMatching = FALSE) {
if (!isTRUE(reportMatching)) {
# Remove unnecessary metadata that will slow calculations
tree1 <- TopologyOnly(tree1)
tree2 <- TopologyOnly(tree2)
}

unnormalized <- CalculateTreeDistance(InfoRobinsonFouldsSplits, tree1, tree2,
reportMatching) * 2

Expand Down Expand Up @@ -96,10 +102,16 @@ InfoRobinsonFouldsSplits <- function(splits1, splits2,
}

#' @rdname Robinson-Foulds
#' @importFrom TreeTools NSplits as.ClusterTable
#' @importFrom TreeTools as.ClusterTable NSplits TopologyOnly
#' @export
RobinsonFoulds <- function(tree1, tree2 = NULL, similarity = FALSE,
normalize = FALSE, reportMatching = FALSE) {
if (!isTRUE(reportMatching)) {
# Remove unnecessary metadata that will slow calculations
tree1 <- TopologyOnly(tree1)
tree2 <- TopologyOnly(tree2)
}

if (is.null(tree2)) {
ct <- as.ClusterTable(tree1)
rf <- robinson_foulds_all_pairs(if(is.list(ct)) ct else list(ct))
Expand Down
6 changes: 4 additions & 2 deletions tests/testthat/test-tree_distance.R
Original file line number Diff line number Diff line change
Expand Up @@ -448,6 +448,7 @@ test_that("Clustering information is correctly calculated", {
tip.label = c("t1", "t2", "t3", "t4", "t5", "t6", "t7", "t8", "t9", "t10",
"t11", "t12", "t13", "t14", "t15", "t16", "t17", "t18", "t19",
"t20"), br = NULL), class = "phylo")
# NOT in Preorder. Preordering the tree will change the matching.
threeAwayPoly <- structure(
list(edge = structure(c(21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 29L,
28L, 27L, 26L, 30L, 30L, 30L, 26L, 31L, 31L, 25L,
Expand All @@ -463,8 +464,9 @@ test_that("Clustering information is correctly calculated", {
expect_equal(
MutualClusteringInfo(threeAwayPoly, randomBif20),
MutualClusteringInfo(randomBif20, threeAwayPoly))
match <- MutualClusteringInfo(randomBif20, threeAwayPoly, reportMatching = TRUE)
expect_equal(c(NA, NA, 1, 2, NA, 3, 7, 11, 10, 4, 6, 9, 8, NA, 5, 12, NA),
match <- MutualClusteringInfo(randomBif20, threeAwayPoly,
reportMatching = TRUE)
expect_equal(c(NA, NA, 1, 2, NA, 3, 7, 11, 10, 4, 6, 9, 8, NA, 5, 12, NA),
attr(match, "matching"))

# Multiple bins, calculated expectation
Expand Down

0 comments on commit ceef251

Please sign in to comment.