tests/testthat/test-unbranch.R

context("unbranching a tree")

# set this for testing
dendextend_options("warn", TRUE)

test_that("Get attribute of node's branches (height)", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)

  expect_equal(get_root_branches_attr(dend, "height"), c(0, 37.17700902))
  expect_true(unlist(get_root_branches_attr(dend, "leaf")))
  expect_warning(get_root_branches_attr(unclass(dend), "height")) # warn when used on an object which is NOT of class "dendrogram"
})


test_that("Raising a dendrogram's root height", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)

  taller_dend <- raise.dendrogram(dend, 10)
  shorter_dend <- raise.dendrogram(dend, -10)

  expect_equal(attr(dend, "height"), 54.800410723)
  expect_equal(attr(taller_dend, "height"), 64.800410723)
  expect_equal(attr(shorter_dend, "height"), 44.800410723)
})



test_that("unbranching a dendrogram", {
  hc <- hclust(dist(USArrests[10:13, ]), "ave")
  dend <- as.dendrogram(hc)
  #    plot(dend)

  unbranched_dend <- unbranch(dend, 1)
  unbranched_dend_2 <- unbranch(unbranched_dend, 3)
  #    plot(unbranched_dend)
  #    plot(unbranched_dend_2)

  expect_equal(length(unbranched_dend), 3L) # our new tree has 3 branches
  expect_equal(length(unbranched_dend_2), 4L) # our new tree has 3 branches
  expect_equal(labels(dend), labels(unbranched_dend_2)) # order of leaves is preserved
  expect_warning(unbranch(dend[[1]])) # since the new root can not be a leaf.
  expect_error(unbranch(hc)) # While there is an hclust method,
  # this object can not handle non-binary trees.
})


dendextend_options("warn", FALSE)

Try the dendextend package in your browser

Any scripts or data that you put into this service are public.

dendextend documentation built on Oct. 13, 2024, 1:06 a.m.