# library(testthat) # fixing how the tests are printed # cat("\n") context("Measuring entanglement of two trees") test_that("Match order of one dend based on another (using their labels)", { dend <- USArrests[1:4, ] %>% dist() %>% hclust() %>% as.dendrogram() expect_identical(order.dendrogram(dend), c(4L, 3L, 1L, 2L)) dend_changed <- dend order.dendrogram(dend_changed) <- 1:4 expect_identical(order.dendrogram(dend_changed), c(1:4)) # now let's fix the order of the new object to be as it was: dend_changed <- match_order_by_labels(dend_changed, dend) expect_identical(order.dendrogram(dend_changed), order.dendrogram(dend)) # producing an error due to different labels in the two trees: # Fails when tree sizes are different: expect_error(match_order_by_labels(dend_changed[[-1]], dend)) # It would also fail when one of the labels is different: labels(dend_changed)[1] <- "CAT" expect_error(match_order_by_labels(dend_changed, dend)) }) test_that("Match order of one dend based on another (using their order valuess)", { dend <- as.dendrogram(hclust(dist(USArrests[1:4, ]))) expect_identical(order.dendrogram(dend), c(4L, 3L, 1L, 2L)) dend_changed <- dend order.dendrogram(dend_changed) <- 1:4 expect_identical(order.dendrogram(dend_changed), c(1:4)) # now let's fix the order of the new object to be as it was: dend_changed <- match_order_dendrogram_by_old_order( dend_changed, dend, order.dendrogram(dend_changed) ) expect_identical(order.dendrogram(dend_changed), order.dendrogram(dend)) # Watch this! # take a dend and change it: dend_changed <- dend dend_changed <- rev(dend_changed) expect_false(identical(order.dendrogram(dend_changed), order.dendrogram(dend))) # we keep the order of dend_change, so that the leaves order are synced # with their labels JUST LIKE dend: old_dend_changed_order <- order.dendrogram(dend_changed) # now we change dend_changed leaves order values: order.dendrogram(dend_changed) <- 1:4 # and we can fix them again, based on their old kept leaves order: # # alabama and alaska are different # data.frame(order.dendrogram(dend), # labels(dend), # order.dendrogram(dend_changed), # labels(dend_changed)) # a = match_order_dendrogram_by_old_order(dend_changed, dend, # order.dendrogram(dend)) # order.dendrogram(a) # labels(a) # I am not sure this works right... # dend_changed <- match_order_dendrogram_by_old_order(dend_changed, dend, # old_dend_changed_order) # expect_identical(order.dendrogram(dend_changed), order.dendrogram(dend)) # expect_identical(order.dendrogram(dend_changed), order.dendrogram(dend)) # identical(match_order_by_labels(dend_changed, dend), dend_changed) }) test_that("Entanglement works", { hc1 <- hclust(dist(datasets::iris[, -5]), "com") hc2 <- hclust(dist(datasets::iris[, -5]), "single") dend1 <- as.dendrogram(hc1) dend2 <- as.dendrogram(hc2) expect_identical(round(entanglement(dend1, dend2, 0, "labels"), 2), 1) expect_identical(round(entanglement(dend1, dend2, 1, "labels"), 2), 0.93) expect_identical(round(entanglement(dend1, dend2, 1.5, "labels"), 2), 0.91) expect_identical(round(entanglement(dend1, dend2, 2, "labels"), 2), 0.89) expect_identical( round(entanglement(dend1, dend2, 2, "labels"), 2), round(entanglement(dend1, dend2, 2, "order"), 2) ) # library(microbenchmark) # microbenchmark(entanglement(dend1 , dend2, 2, "labels"), # entanglement(dend1 , dend2, 2, "order"), times = 10L ) # order is about twice as fast... }) test_that("Entanglement with labels vs order", { hc1 <- hclust(dist(iris[, -5]), "com") hc2 <- hclust(dist(iris[, -5]), "single") dend1 <- as.dendrogram(hc1) dend2 <- as.dendrogram(hc2) # massing up the order of leaves is dangerous: expect_identical(round(entanglement(dend1, dend2, 1.5, "order"), 2), 0.91) order.dendrogram(dend2) <- seq_len(nleaves(dend2)) # this 0.95 number is NO LONGER correct!! expect_identical(round(entanglement(dend1, dend2, 1.5, "order"), 2), 0.95) # but if we use the "labels" method - we still get the correct number: expect_identical(round(entanglement(dend1, dend2, 1.5, "labels"), 2), 0.91) # however, we can fix our dend2, as follows: dend2 <- match_order_by_labels(dend2, dend1) # Now that labels and order are matched - entanglement is back at working fine: expect_identical(round(entanglement(dend1, dend2, 1.5, "order"), 2), 0.91) }) test_that("Entanglement works for dendlist objects ", { dend1 <- iris[, -5] %>% dist() %>% hclust("com") %>% as.dendrogram() dend2 <- iris[, -5] %>% dist() %>% hclust("sin") %>% as.dendrogram() dend12 <- dendlist(dend1, dend2) expect_identical( entanglement(dend12, L = .25), entanglement(dend1, dend2, L = .25) ) })