1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
# 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)
)
})
|
