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
|
context("Coloring tree's labels")
test_that("Leaves color is NULL", {
hc <- hclust(dist(USArrests[1:3, ]), "ave")
dend <- as.dendrogram(hc)
# Defaults:
expect_equal(labels_colors(dend), NULL)
})
test_that("Setting and extracting leaves color", {
hc <- hclust(dist(USArrests[1:3, ]), "ave")
dend <- as.dendrogram(hc)
# let's add some color:
labels_colors(dend) <- 2:4
# getting it (without labels)
expect_equal(labels_colors(dend, labels = FALSE), 2:4)
# getting it (with labels)
expect_equal(labels_colors(dend), structure(2:4, .Names = c("Arizona", "Alabama", "Alaska")))
})
test_that("Setting and extracting leaves color (some are NA)", {
hc <- hclust(dist(USArrests[1:3, ]), "ave")
dend <- as.dendrogram(hc)
# let's add some color:
labels_colors(dend) <- c(2, NA, 4)
# getting it (without labels)
expect_equal(labels_colors(dend, labels = FALSE), c(2, NA, 4))
# getting it (with labels)
expect_equal(labels_colors(dend), structure(c(2, NA, 4), .Names = c("Arizona", "Alabama", "Alaska")))
})
test_that("Color recycling", {
hc <- hclust(dist(USArrests[1:3, ]), "ave")
dend <- as.dendrogram(hc)
# changing color to black, see that recycling works
dendextend_options("warn", TRUE)
expect_warning(labels_colors(dend) <- 1)
dendextend_options("warn", FALSE)
expect_equal(labels_colors(dend, labels = FALSE), rep(1, 3))
})
test_that("Color removing", {
hc <- hclust(dist(USArrests[1:3, ]), "ave")
dend <- as.dendrogram(hc)
labels_colors(dend) <- 2:4
# removing color (and the nodePar completely - if it has no other attributed but lab.col)
expect_warning(labels_colors(dend) <- NULL)
expect_equal(labels_colors(dend), NULL)
})
test_that("Can't color a non-dendrogram object", {
hc <- hclust(dist(USArrests[1:3, ]), "ave")
expect_error(labels_colors(hc))
expect_error(labels_colors(hc) <- NULL)
})
test_that("Can color the labels of super flat trees", {
dend_flat <- structure(list(
structure(88L, members = 1L, height = 0, label = "mel Ch m pe", leaf = TRUE, value = 83),
structure(list(
structure(92L, members = 1L, height = 0, label = "mel Ch f fo", leaf = TRUE, value = 84),
structure(list(
structure(90L, members = 1L, height = 0, label = "mel Ch f he", leaf = TRUE, value = 85),
structure(list(
structure(84L, label = "mel Ch m he", members = 1L, height = 0, leaf = TRUE, value = 86),
structure(86L, label = "mel Ch m fo", members = 1L, height = 0, leaf = TRUE, value = 87)
), members = 2L, midpoint = 0.5, height = 0, value = 86.5)
), members = 3L, midpoint = 0.75, height = 0, value = 85.75)
), members = 4L, midpoint = 0.875, height = 0, value = 84.875)
), members = 5L, midpoint = 0.9375, height = 0.0697674418604651, value = 83.9375, class = "dendrogram")
### didn't work in dendextend 0.17.2
# dend_flat %>% color_labels %>% plot
# dend_flat %>% color_labels(col = 1:2) %>% plot # doesn't works
# no colors by default
expect_null(dend_flat %>% labels_colors())
# but now we do get colors:
dend_col_1 <- dend_flat %>%
color_labels() %>%
labels_colors() %>%
unname()
expect_identical(
dend_col_1,
c("#CC476B", "#917600", "#009232", "#008FB7", "#A352D1")
)
dend_col_2 <- dend_flat %>%
color_labels(col = 1:2) %>%
labels_colors() %>%
unname()
expect_identical(
dend_col_2,
c(1L, 2L, 1L, 2L, 1L)
)
# dput(dend_col_2)
# dput(dend_col_2)
})
test_that("Using set leaves_col still allows for set labels_colors", {
dend <- USArrests[1:5, ] %>%
dist() %>%
hclust("ave") %>%
as.dendrogram()
dend <- dend %>%
# set("leaves_pch", c(4, 1)) %>%
set("leaves_col", c(5, 1)) %>%
set("labels_colors", c(3, 1))
# plot(dend)
# str(unclass(dend))
# dput(unname(labels_colors(dend)))
expect_identical(unname(labels_colors(dend)), c(3, 1, 3, 1, 3))
})
# library(testthat)
|
