tests/testthat/test-labels-assign.R

In talgalili/dendextend: Extending 'dendrogram' Functionality in R

# library(testthat)

context("labels assignment")

test_that("labels assginment works for vectors", {
  x <- 1:3
  # expect_that(labels(x), equals(as.character(1:3))) # notice this is 1:3 as character
  expect_equal(labels(x), (as.character(1:3))) # notice this is 1:3 as character

  labels(x) <- letters[1:3]
  expect_equal(labels(x), (letters[1:3]))
  # labels(x) # [1] "a" "b" "c"
  labels(x)[1] <- "one"
  expect_equal(labels(x), c("one", "b", "c")) # checking specific assignment
})



# test_that("labels assginment works for matrix",{
# y <- matrix(1:9, 3,3)
# expect_equal(labels(y), (NULL))

# labels(y) <- letters[1:3] # defaults to assign labels to columns
# expect_equal(labels(y), (letters[1:3]))
# expect_equal(colnames(y), (letters[1:3]))

# labels(y, which = "rownames") <- letters[24:26]
# expect_equal(labels(y, which = "rownames"), letters[24:26])
# expect_equal(rownames(y), letters[24:26])

# labels(y)[1] <- "one"
# expect_equal(labels(y), c("one", "b", "c")) # checking specific assignment
# })




test_that("labels (with order=TRUE, by default), before and after assginment, works for hclust", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")

  #    plot(hc)
  #    expect_that(labels(hc), equals(c("Alabama", "Alaska", "Arizona")))
  expect_equal(labels(hc), c("Arizona", "Alabama", "Alaska"))

  labels(hc) <- letters[1:3]
  expect_equal(labels(hc), letters[1:3])

  labels(hc)[1] <- "one"
  expect_equal(labels(hc), c("one", "b", "c")) # checking specific assignment
})


test_that("labels (without order!) works for hclust", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  #    plot(hc)
  # expect_that(labels(hc, order = FALSE), equals(c("Alabama", "Alaska", "Arizona")))
  expect_equal(labels(hc, order = FALSE), c("Alabama", "Alaska", "Arizona"))
})


test_that("labels (without order!) works differently than labels assignment (which are WITH order) for hclust", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  #    plot(hc)
  # expect_that(labels(hc, order = FALSE), equals(c("Alabama", "Alaska", "Arizona")))
  expect_equal(labels(hc, order = FALSE), c("Alabama", "Alaska", "Arizona"))

  labels(hc) <- letters[1:3]

  # expect_that(identical(labels(hc, order = FALSE) , letters[1:3]),
  # is_false())
  expect_false(identical(labels(hc, order = FALSE), letters[1:3]))
})


test_that("labels assginment works for dendrogram", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)

  expect_equal(labels(dend), c("Arizona", "Alabama", "Alaska"))

  labels(dend) <- letters[1:3]
  expect_equal(labels(dend), letters[1:3])

  labels(dend)[1] <- "one"
  expect_equal(labels(dend), c("one", "b", "c")) # checking specific assignment
  
  # if 'value' parameter missing
  dendextend_options("warn", T)
  expect_warning(
     `labels<-`(dend)
  )
  dendextend_options("warn", F)
})


test_that("labels for hclust and dendrogram are (by default) the same", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)
  # hc and dend labels should NOT be identical.
  expect_true(identical(labels(dend), labels(hc)))
})




test_that("labels assginment recycles properly and consistently", {
  x <- 1:3
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)
  # y <- matrix(1:9, 3,3)

  suppressWarnings({
    labels(x) <- letters[1]
    labels(hc) <- letters[1]
    labels(dend) <- letters[1]
    # labels(y) <- letters[1] # defaults to assign labels to columns
    # labels(y, which = "rownames") <- letters[24]
  })

  expect_equal(labels(x), (rep(letters[1], 3)))
  expect_equal(labels(hc), (rep(letters[1], 3)))
  expect_equal(labels(dend), (rep(letters[1], 3)))
  # expect_equal(labels(y), (rep(letters[1], 3)))
  # expect_equal(labels(y, which = "rownames"), (rep(letters[24], 3)))
  # labels(x) # [1] "a" "b" "c"
})


test_that("labels assginment issues warning when using recycling", {
  x <- 1:3
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)
  # y <- matrix(1:9, 3,3)

  #    expect_that(labels(x) <- letters[1], gives_warning())
  expect_warning(labels(x) <- letters[1])
  expect_warning(labels(hc) <- letters[1])
  expect_warning(labels(dend) <- letters[1])
  # expect_warning(labels(y) <- letters[1])
  # expect_warning(labels(y, which = "rownames") <- letters[24])
})


test_that("labels assginment to dendrogram keeps the child nodes as NOT of dendrogram class", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)
  labels(dend) <- letters[1:3]

  expect_true(class(unclass(dend)[[2]]) == "list")
})



test_that("order of leaves in sub-dendrogram and as.hclust", {
  # For example:
  hc <- hclust(dist(USArrests[1:6, ]), "ave")
  dend <- as.dendrogram(hc)
  sub_dend <- dend[[1]]

  # bad order
  expect_equal(order.dendrogram(sub_dend), c(4, 6))
  # bad labels:
  #    expect_equal(labels(as.hclust(sub_dend)), as.character(rep(NA,2)))
  # since R 3.1.1-patched - the above will produce an error. (as it should)

  # let's fix it:
  order.dendrogram(sub_dend) <- rank(order.dendrogram(sub_dend), ties.method = "first")
  expect_equal(labels(as.hclust(sub_dend)), c("Arkansas", "Colorado"))
  # We now have labels :)
})



test_that("labels of hclust on data without rownames is an integer", {
  # this is a problem when some function assumes that labels are "character"
  DATA <- USArrests
  rownames(DATA) <- NULL
  hc <- hclust(dist(DATA))
  dend <- as.dendrogram(hc)
  expect_true(length(labels(hc)) == 0) # hc has NO labels
  expect_true(is.integer(labels(dend))) # the labels the dend gets are Integer
})






test_that("order of leaves can be extracted and changed", {
  hc <- hclust(dist(USArrests[1:3, ]), "ave")
  dend <- as.dendrogram(hc)

  expect_identical(order.dendrogram(dend), c(3L, 1L, 2L))

  # change order:
  order.dendrogram(dend) <- 1:3
  expect_identical(order.dendrogram(dend), 1:3)

  # change order (with replications):
  expect_warning(order.dendrogram(dend) <- c(1, 2))
  expect_identical(order.dendrogram(dend), as.integer(c(1, 2, 1)))
})


test_that("labels assignment works for phylo objects", {
   hc <- hclust(dist(USArrests[1:3, ]), "ave")
   ph <- ape::as.phylo(hc)
   
   labels(ph) <- c("Al", "Ak", "Az")
   expect_identical(
      labels.phylo(ph),
      c("Al", "Ak", "Az")
   )
   
   # if replacement labels are incorrect length
   expect_warning(
      labels(ph) <- c("Al", "Ak")   
   )
   # if 'value' parameter missing
   dendextend_options("warn", T)
   expect_warning(
      `labels<-.phylo`(ph)
   )
   dendextend_options("warn", F)
})


test_that("order.dendrogram works", {
   hc <- hclust(dist(USArrests[1:3, ]), "ave")
   dend <- as.dendrogram(hc)
   
   # if non-numeric order passed in
   expect_warning(
      order.dendrogram(dend) <- c("1", "2", "3")   
   )
   
})


test_that("order.hclust works", {
   x <- dist(USArrests[1:3, ])
   hc <- hclust(x, "ave")
   
   expect_equal(
      order.hclust(hc),
      c(3, 1, 2)
   )
   
   # if non-hclust object passed in
   expect_error(
      order.hclust(x)
   )
   
})


test_that("place_labels works", {
   hc <- hclust(dist(USArrests[1:3, ]), "ave")
   dend <- as.dendrogram(hc)
   
   result <- place_labels(dend, labels(dend))
   expect_identical(
      labels(result),
      c("Alaska", "Arizona", "Alabama")
   )
   
})