tests/testthat/test-rotate.R

In dendextend: Extending 'dendrogram' Functionality in R

# library(testthat)

context("Rotate a tree around its hinges")


test_that("Rotate a dendrogram", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)

  #    labels(dend)
  #    rev(labels(dend))

  expect_equal(rev(labels(dend)), labels(rotate(dend, 3:1)))
  expect_equal(rev(labels(dend)), labels(rotate(dend, rev(labels(dend)))))
  
  # test case where an object other than dendrogram/hclust/phylo is passed in
  x <- matrix(1:4, nrow = 2)
  expect_error(rotate(x))
  
  # test case where order argument is missing
  expect_warning(
     rotated_dend <- rotate(dend)
  )
  expect_identical(rotated_dend, dend)
  
  # test case where not all leaves are specified in order and order is not numeric
  expect_error(rotate(dend, c("Alaska", "Alabama")))
})


test_that("Rotate a dendrogram (but not exactly to what we asked for)", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)

  new_order <- c(3, 1, 2) # an impossible order, will fail
  expect_false(all(labels(dend)[new_order] == labels(rotate(dend, new_order))))
  expect_false(all(labels(dend)[new_order] == labels(rotate(dend, labels(dend)[new_order]))))
  #    plot(rotate(dend, new_order))
  #    plot(dend)
})



test_that("Rotate a dendrogram - works with either numeric or character", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)

  new_order <- c(2, 3, 1) # a possible order

  expect_equivalent(rotate(dend, new_order), rotate(dend, labels(dend)[new_order]))
  #    plot(rotate(dend, new_order))
  #    plot(rotate(dend, labels(dend)[new_order]) )
  #    match(labels(dend)[new_order], labels(dend)) # NEW-OLD
  #    new_order
  expect_equivalent(
    labels(rotate(dend, new_order)),
    labels(rotate(dend, labels(dend)[new_order]))
  )
})







test_that("Rotate hclust", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")

  #    labels(hc)
  #    rev(labels(hc))
  #    plot(hc)
  #    plot(rotate(hc, 3:1))

  expect_equal(rev(labels(hc)), labels(rotate(hc, 3:1)))
  expect_equal(rev(labels(hc)), labels(rotate(hc, rev(labels(hc)))))
})


test_that("Rotate a hclust (but not exactly to what we asked for)", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")

  new_order <- c(3, 1, 2) # an impossible order, will fail
  expect_false(all(labels(hc)[new_order] == labels(rotate(hc, new_order))))
  expect_false(all(labels(hc)[new_order] == labels(rotate(hc, labels(hc)[new_order]))))
  #    plot(rotate(hc, new_order))
  #    plot(hc)
})


test_that("rotate.phylo works", {
   hc <- hclust(dist(USArrests[1:3, ]), "ave")
   dend <- as.dendrogram(hc)
   
   x <- ape::as.phylo(dend)
   rotated_x <- rotate.phylo(x, c("Alaska", "Alabama"))
   
   dend_labels_reodered <- labels(dend) 
   dend_labels_reodered[2:3] <- dend_labels_reodered[3:2]
   rotated_dend <- rotate(dend, order = dend_labels_reodered)
   # same rotation applied, so labels should be ordered the same
   expect_identical(labels(rotated_dend), labels(as.dendrogram(rotated_x)))
   
   # test case where phy argument is provided
   rotated_x <- rotate.phylo(NULL, c("Alaska", "Alabama"), phy = x)
   expect_identical(labels(rotated_dend), labels(as.dendrogram(rotated_x)))
})


test_that("sort.dendrogram works", {
   hc <- hclust(dist(USArrests[1:3, ]), "ave")
   dend <- as.dendrogram(hc)
   
   # sorting should switch order
   expect_identical(labels(dend), c("Arizona", "Alabama", "Alaska"))
   sorted_dend <- sort.dendrogram(dend, type = "nodes")
   expect_identical(labels(sorted_dend), c("Arizona", "Alaska", "Alabama"))
})


test_that("sort.hclust works", {
   hc <- hclust(dist(USArrests[1:3, ]), "ave")
   
   # sorting should switch order
   expect_identical(labels(hc), c("Arizona", "Alabama", "Alaska"))
   sorted_hc <- sort.hclust(hc, decreasing = T)
   expect_identical(labels(sorted_hc), c("Arizona", "Alaska", "Alabama"))
})


test_that("sort.dendlist works", {
   hc <- hclust(dist(USArrests[1:5, ]), "ave")
   dend1 <- as.dendrogram(hc)
   hc <- hclust(dist(USArrests[6:10, ]), "ave")
   dend2 <- as.dendrogram(hc)
   dends <- dendlist(dend1, dend2)
   
   sorted_dends <- sort.dendlist(dends)
   # sorting should switch order
   expect_identical(labels(dend1), c("Arkansas", "Arizona", "California", "Alabama", "Alaska" ))
   expect_identical(labels(sorted_dends[[1]]), c("Alabama", "Alaska", "Arizona", "California", "Arkansas"))
   
   expect_identical(labels(dend2), c("Florida", "Connecticut", "Delaware", "Colorado", "Georgia"))
   expect_identical(labels(sorted_dends[[2]]), c("Connecticut", "Delaware", "Colorado", "Georgia", "Florida"))
})


test_that("rev.hclust works", {
   hc <- hclust(dist(USArrests[1:3, ]), "ave")
   
   # should reverse order
   ordered_labels <- c("Arizona", "Alabama", "Alaska")
   expect_identical(labels(hc), ordered_labels)
   reversed_hc <- rev.hclust(hc, decreasing = T)
   expect_identical(labels(reversed_hc), ordered_labels[3:1])
})


test_that("ladderize works", {
   # test case where an object other than dendrogram is passed in
   x <- matrix(1:4, nrow = 2)
   expect_error(ladderize(x))
   
   # test for ladderize.phylo
   hc <- hclust(dist(USArrests[10:1, ]), "ave")
   dend <- as.dendrogram(hc)
   x <- ape::as.phylo(dend)
   ladderized_x <- ladderize(x, right = F)
   # order of edge should have changed 
   expect_false(identical(ladderized_x$edge, x$edge))
   
   # test when a dendrogram isn't passed in
   x <- matrix(1:4, nrow = 2)
   expect_error(ladderize.dendrogram(x))
   
   # test when a phylo isn't passed in
   x <- ape::as.phylo(dend)
   ladderized_x <- ladderize.phylo(NULL, phy = x)
   expect_false(identical(ladderized_x$edge, x$edge))
})


test_that("click_rotate works", {
   # test case where an object other than dendrogram is passed in
   x <- matrix(1:4, nrow = 2)
   expect_error(click_rotate(x))
   
   # test for ladderize.phylo
   hc <- hclust(dist(USArrests[10:1, ]), "ave")
   dend <- as.dendrogram(hc)
   
   # temporarily redefine interactive locator function to click leaf which causes no rotation in click_rotate and returns the same dendrogram
   capture.output(with_mock(
      locator = function(n = 1) list(x = 1, y = -11),
      result <- click_rotate(dend, plot = TRUE, horiz = FALSE, continue = TRUE)
   ))
   expect_identical(labels(dend), labels(result))
   
})