Skip to content

Commit

Permalink
Tests for color_branches (#134)
Browse files Browse the repository at this point in the history
* 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
alecbuetow authored Nov 3, 2024
1 parent 17afcb9 commit 4b726e9
Show file tree
Hide file tree
Showing 3 changed files with 186 additions and 5 deletions.
20 changes: 17 additions & 3 deletions tests/testthat/test-bk_method.R
Original file line number Diff line number Diff line change
Expand Up @@ -119,12 +119,17 @@ test_that("FM_index_R works", {
FM_index_R(hc1_with_na, cutree(hc1, k = 3), warn = T)
)

# test case where unequal length clusters are passed in
x = c(1,2,3,4)
y = c(1,2,3,4,5)
# create custom class to pass in which triggers error otherwise not possible
x <<- c(1, 2, 3, 4, 5)
class(x) <<- "x"
length.x <<- function(x) 1
y <<- c(1, 2, 3, 4, 5)
class(y) <<- "y"
length.y <<- function(y) 1
expect_error(
FM_index_R(x, y, assume_sorted_vectors = T)
)

})


Expand Down Expand Up @@ -326,4 +331,13 @@ test_that("Bk_plot works", {
expect_no_error(
Bk_plot(dend1, dend2, try_cutree_hclust = T, add_E = F, rejection_line_asymptotic = T, rejection_line_permutation = T)
)

# case where object which cant be converted to phylo is passed in
x <- matrix(1:4, nrow = 2)
expect_error(
Bk_plot(x, dend2, try_cutree_hclust = T, add_E = F, rejection_line_asymptotic = T, rejection_line_permutation = T)
)
expect_error(
Bk_plot(dend1, x, try_cutree_hclust = T, add_E = F, rejection_line_asymptotic = T, rejection_line_permutation = T)
)
})
166 changes: 166 additions & 0 deletions tests/testthat/test-color_branches.R
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)
)

})
5 changes: 3 additions & 2 deletions tests/testthat/test-rotate.R
Original file line number Diff line number Diff line change
Expand Up @@ -174,8 +174,9 @@ test_that("ladderize works", {
expect_error(ladderize.dendrogram(x))

# test when a phylo isn't passed in
x <- matrix(1:4, nrow = 2)
expect_error(ladderize.phylo(x))
x <- ape::as.phylo(dend)
ladderized_x <- ladderize.phylo(NULL, phy = x)
expect_false(identical(ladderized_x$edge, x$edge))
})


Expand Down

0 comments on commit 4b726e9

Please sign in to comment.