-
Notifications
You must be signed in to change notification settings - Fork 29
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
* added edge cases for rotate.R and bk_method.R * added tests for color_branches * added tests for color_branches * correct error in color_branches test * added tests for leaf_Colors * added tests for color_branches_by_clusters * fixed FM_index_R test
- Loading branch information
1 parent
17afcb9
commit 4b726e9
Showing
3 changed files
with
186 additions
and
5 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,166 @@ | ||
# library(testthat) | ||
# library(dendextend) | ||
|
||
|
||
test_that("color_branches works", { | ||
|
||
dend <- c(1:5) %>% | ||
dist() %>% | ||
hclust() %>% | ||
as.dendrogram() | ||
|
||
# test case where k and colors are misaligned | ||
expect_warning(dend %>% color_branches(k = 3, col = c("red", "green"))) | ||
expect_warning(dend %>% color_branches(k = 2, col = c("red", "green", "blue"))) | ||
|
||
# test case where k and cluster are both provided | ||
expect_warning(dend %>% color_branches(k = 2, clusters = c(1, 1, 2, 2, 3))) | ||
|
||
# test case where number of cluster does not equal number of leaves | ||
expect_warning(dend %>% color_branches(clusters = c(1, 1, 2, 3))) | ||
|
||
# test case where labels are not unique, also tests when both k and h aren't specified | ||
labels(dend)[2] = 1 | ||
expect_warning(dend %>% color_branches(warn = T)) | ||
|
||
# test when non-dendrogram object is passed in | ||
x <- matrix(1:4, nrow = 2) | ||
expect_error(x %>% color_branches(clusters = c(1, 1))) | ||
hc <- c(1:5) %>% | ||
dist() %>% | ||
hclust() | ||
dend <- as.dendrogram(hc) | ||
expect_equal(color_branches(hc), color_branches(dend)) # hc gets converted to dendrogram so should be the same | ||
|
||
# temporarily redefine cutree to return 0 so we can activate warning for 'dend has only one level' | ||
expect_warning(with_mock( | ||
`dendextend::cutree` = function(...) 0, | ||
color_branches(dend, k = 2, warn = T) | ||
)) | ||
|
||
# test when groupLabels argument used | ||
expect_error( | ||
color_branches(dend, k = 2, warn = T, groupLabels = function(...) TRUE) | ||
) | ||
# structure doesnt change | ||
result1 <- color_branches(dend, k = 2, warn = T, groupLabels = TRUE) | ||
result2 <- color_branches(dend, k = 2, warn = T, groupLabels = FALSE) | ||
expect_equal( | ||
result1, | ||
result2 | ||
) | ||
# should be labeled now | ||
suppressWarnings(expect_identical( | ||
dendrapply(result1, function(dend_node) attributes(dend_node))$members$edgetext$label, | ||
"1" | ||
)) | ||
# should remain unlabeled | ||
suppressWarnings(expect_identical( | ||
dendrapply(result2, function(dend_node) attributes(dend_node))$members$edgetext$label, | ||
NULL | ||
)) | ||
}) | ||
|
||
|
||
test_that("color_labels works", { | ||
|
||
dend <- c(1:5) %>% | ||
dist() %>% | ||
hclust() %>% | ||
as.dendrogram() | ||
|
||
# should recolor first and second label to red | ||
colorful_dend = color_labels(dend, labels = c(1,2), col = "red") | ||
expect_identical( | ||
dendrapply(colorful_dend, function(dend_node) attributes(dend_node))$members$members$nodePar$lab.col, | ||
"red" | ||
) | ||
|
||
# color and labels vector have a length mismatch, creates warning because it has to recycle colors | ||
expect_warning( | ||
color_labels(dend, labels = c(3,4,5), col = c("red", "blue"), warn = T) | ||
) | ||
|
||
# if something other than a dend / hclust is passed in | ||
x <- matrix(1:4, nrow = 2) | ||
expect_error(color_labels(x)) | ||
|
||
# if hclust is passed in | ||
hc <- c(1:5) %>% | ||
dist() %>% | ||
hclust() | ||
colorful_dend = color_labels(hc, k = 2) | ||
expect_identical( | ||
dendrapply(colorful_dend, function(dend_node) attributes(dend_node))$members$members$nodePar$lab.col, | ||
"#CC476B" | ||
) | ||
|
||
# if misalignment in k and number of colors | ||
expect_warning( | ||
color_labels(dend, k = 3, col = c("red", "blue"), warn = T) | ||
) | ||
expect_warning( | ||
color_labels(dend, k = 2, col = c("red", "blue", "green"), warn = T) | ||
) | ||
|
||
}) | ||
|
||
|
||
test_that("lty_branches works", { | ||
|
||
dend <- c(1:5) %>% | ||
dist() %>% | ||
hclust() %>% | ||
as.dendrogram() | ||
|
||
# dend branches for second cluster should be dashed (aka lty = 2) | ||
lty_dend = lty_branches(dend, k = 2) | ||
suppressWarnings(expect_identical( | ||
dendrapply(lty_dend, function(dend_node) attributes(dend_node))$class$class$edgePar$lty, | ||
2 | ||
)) | ||
}) | ||
|
||
|
||
test_that("leaf_Colors works", { | ||
|
||
dend <- c(1:5) %>% | ||
dist() %>% | ||
hclust() %>% | ||
as.dendrogram() | ||
colorful_dend = color_labels(dend, k = 2) | ||
|
||
# extract leaf labels (none for uncolored dendrogram vs. #CC476B and #009681 for colorful dendrogram) | ||
expect_true( | ||
all(is.na(leaf_Colors(dend, "label"))) | ||
) | ||
expect_true( | ||
all(leaf_Colors(colorful_dend, "label") == c("#CC476B", "#CC476B", "#009681", "#009681", "#009681")) | ||
) | ||
|
||
# if something other than a dend | ||
x <- matrix(1:4, nrow = 2) | ||
expect_error(leaf_Colors(x)) | ||
}) | ||
|
||
|
||
test_that("color_branches_by_clusters works", { | ||
|
||
dend <- c(1:5) %>% | ||
dist() %>% | ||
hclust() %>% | ||
as.dendrogram() | ||
|
||
# cluster color for the first edge should be based on cluster # 2 | ||
colorful_dend = color_branches_by_clusters(dend, clusters = c(2,2,1,1,1), order_value = T) | ||
suppressWarnings(expect_identical( | ||
dendrapply(colorful_dend, function(dend_node) attributes(dend_node))$members$members$edgePar$col, | ||
"2" | ||
)) | ||
|
||
# if wrong number of clusters is passed in | ||
expect_error( | ||
color_branches_by_clusters(dend, clusters = c(2,2,1,1), order_value = T) | ||
) | ||
|
||
}) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters