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
|
# library(testthat)
context("branches_attr_by_")
test_that("is.infinite works", {
expect_false(is.infinite(NA))
expect_false(is.infinite(as.numeric(NA)))
expect_true(is.infinite(Inf))
expect_false(is.infinite("Inf"))
expect_true(is.infinite(as.numeric("Inf")))
})
test_that("assign_values_to_branches_edgePar - when trying to keep a value un-touched", {
a <- c(1:2) %>%
dist() %>%
hclust() %>%
as.dendrogram()
# this is how we want it to look:
# Original remains:
# str(assign_values_to_branches_edgePar(a, value = c(1,"Inf"), edgePar = "col"))
# str(assign_values_to_branches_edgePar(a, value = c(1,Inf), edgePar = "col"))
# A change is made:
# str(assign_values_to_branches_edgePar(a, value = c(1,NULL), edgePar = "col")) # since it recycles 1
# str(assign_values_to_branches_edgePar(a, value = c(1,NA), edgePar = "col")) # One is 1, and the other NA.
# this is false because one has
# attr(*, "edgePar")= Named num 1
# and the other:
# attr(*, "edgePar")= Named chr "1"
expect_false(
identical(
assign_values_to_branches_edgePar(a, value = c(1, "Inf"), edgePar = "col"),
assign_values_to_branches_edgePar(a, value = c(1, Inf), edgePar = "col")
)
)
# str(unclass(assign_values_to_branches_edgePar(a, value = c(1,"Inf"), edgePar = "col")))
# str(unclass(assign_values_to_branches_edgePar(a, value = c(1,Inf), edgePar = "col")))
# answer %>% unclass %>% str
# plot(answer)
# dput(answer)
answer <- assign_values_to_branches_edgePar(a, value = c(1, "Inf"), edgePar = "col")
true_answer <- structure(list(
structure(1L, label = 1L, members = 1L, height = 0, leaf = TRUE),
structure(2L, label = 2L, members = 1L, height = 0, leaf = TRUE, edgePar = structure(list(
col = "1"
), .Names = "col"))
), members = 2L, midpoint = 0.5, height = 1, edgePar = structure(list(
col = "1"
), .Names = "col"), class = "dendrogram")
expect_true(
identical(answer, true_answer)
)
answer <- assign_values_to_branches_edgePar(a, value = c(1, Inf), edgePar = "col")
true_answer <- structure(list(
structure(1L, label = 1L, members = 1L, height = 0, leaf = TRUE),
structure(2L, label = 2L, members = 1L, height = 0, leaf = TRUE, edgePar = structure(list(
col = 1
), .Names = "col"))
), members = 2L, midpoint = 0.5, height = 1, edgePar = structure(list(
col = 1
), .Names = "col"), class = "dendrogram")
expect_true(
identical(answer, true_answer)
)
answer <- assign_values_to_branches_edgePar(a, value = c(1, NULL), edgePar = "col")
true_answer <- structure(list(structure(1L, label = 1L, members = 1L, height = 0, leaf = TRUE, edgePar = structure(list(
col = 1
), .Names = "col")), structure(2L, label = 2L, members = 1L, height = 0, leaf = TRUE, edgePar = structure(list(
col = 1
), .Names = "col"))), members = 2L, midpoint = 0.5, height = 1, edgePar = structure(list(
col = 1
), .Names = "col"), class = "dendrogram")
expect_true(
identical(answer, true_answer)
)
answer <- assign_values_to_branches_edgePar(a, value = c(1, NA), edgePar = "col")
true_answer <- structure(list(structure(1L, label = 1L, members = 1L, height = 0, leaf = TRUE, edgePar = structure(list(
col = NA_real_
), .Names = "col")), structure(2L, label = 2L, members = 1L, height = 0, leaf = TRUE, edgePar = structure(list(
col = 1
), .Names = "col"))), members = 2L, midpoint = 0.5, height = 1, edgePar = structure(list(
col = 1
), .Names = "col"), class = "dendrogram")
expect_true(
identical(answer, true_answer)
)
})
# dend_node <- 1
# dend_node
# attr(dend_node, "edgePar")[["a"]] <- list(1) # doesn't work
# attr(dend_node, "edgePar")["a"] <- list(1) # works!
# attr(dend_node, "edgePar")["b"] <- list(1) # works!
# attr(dend_node, "edgePar")[["b"]] <- list(1) # doesn't work
test_that("branches_attr_by_labels works", {
dend <- c(1:4) %>%
dist() %>%
hclust() %>%
as.dendrogram()
L <- list(1:2, 3)
tmp <- dend %>% branches_attr_by_lists(L)
expect_equal(attr(tmp[[1]], "edgePar")$col, 2)
expect_equal(attr(tmp[[2]], "edgePar")$col, 2)
expect_equal(attr(tmp[[1]][[1]], "edgePar")$col, 1)
expect_equal(attr(tmp[[1]][[2]], "edgePar")$col, 1)
expect_equal(attr(tmp[[2]][[1]], "edgePar")$col, 2)
expect_equal(attr(tmp[[2]][[2]], "edgePar")$col, 1)
# with changed col/lwd/lty
tmp <- dend %>%
branches_attr_by_lists(L, TF_value = "blue") %>%
branches_attr_by_lists(L, attr = "lwd", TF_value = 4) %>%
branches_attr_by_lists(L, attr = "lty", TF_value = 3)
expect_equal(attr(tmp[[1]], "edgePar")$col, "blue")
expect_equal(attr(tmp[[1]], "edgePar")$lwd, 4)
expect_equal(attr(tmp[[1]], "edgePar")$lty, 3)
# when individual features are selected
tmp <- dend %>% branches_attr_by_lists(c(1, 4))
expect_equal(attr(tmp[[1]], "edgePar")$col, 2)
expect_equal(attr(tmp[[2]], "edgePar")$col, 2)
expect_equal(attr(tmp[[1]][[1]], "edgePar")$col, 2)
expect_equal(attr(tmp[[1]][[2]], "edgePar")$col, 1)
expect_equal(attr(tmp[[2]][[1]], "edgePar")$col, 1)
expect_equal(attr(tmp[[2]][[2]], "edgePar")$col, 2)
})
|
