tests/testthat/test-clustering.r

In nat.nblast: NeuroAnatomy Toolbox ('nat') Extension for Assessing Neuron Similarity and Clustering

context("Clustering")

testneurons <- readRDS('testdata/testneurons.rds')
test_score_mat <- nblast(testneurons, testneurons)

test_that("nhclust with default arguments clusters appropriately", {
  hc <- nhclust(names(testneurons), scoremat=test_score_mat)
  hc.expected.1to5 <- structure(list(merge = structure(c(-3L, -1L, -2L, 1L, -5L, -4L, 2L, 3L), .Dim = c(4L, 2L)), height = c(0.371447118771884, 1.25254918497012, 1.7418094977434, 2.50152423662556), order = c(3L, 5L, 2L, 1L, 4L), labels = c("5HT1bMARCM-F000001_seg001", "5HT1bMARCM-F000002_seg001", "5HT1bMARCM-F000003_seg001", "5HT1bMARCM-F000004_seg001", "5HT1bMARCM-F000005_seg001")), .Names = c("merge", "height", "order", "labels"))
  expect_equal(hc[1:4], hc.expected.1to5)

  # check we can use non-standard distance function
  hc2 <- nhclust(names(testneurons), scoremat=test_score_mat, distfun = function(x) as.dist(x)*2)
  hc2.expected.1to5=hc.expected.1to5
  hc2.expected.1to5$height=hc2.expected.1to5$height*2
  expect_equal(hc2[1:4], hc2.expected.1to5)
})

test_that("plot3d.hclust", {
  hc <- nhclust(names(testneurons), scoremat=test_score_mat)
  open3d()

  # workaround for the fact that colours are rgb or rgba
  cols <- attr(plot3d(hc, k=3, db=testneurons),'df')$col
  baseline <- c("#FF0000", "#FF0000", "#00FF00", "#0000FF", "#0000FF")
  expect_equal(col2rgb(cols), col2rgb(baseline))
  clear3d()
  plot3d(hc, h=2, db=testneurons)
  clear3d()
  expect_equal(attr(plot3d(hc, h=2, db=testneurons, col='red'),'df')$col,
               rep("red", 5))
  rgl.close()
})

test_that('we can use diagonal attribute on a score matrix',{
  if(require("ff")){
    library(nat)
    scores=nblast(kcs20, kcs20)
    scoresff=as.ff(scores)
    scoresffd=scoresff
    attr(scoresffd,'diagonal')=diag(scores)
    # via attributes
    expect_equal(diag(scores), diagonal(scoresffd))
    # from disk using fast_disk_diag
    expect_equal(diag(scores), diagonal(scoresff))
    perm=sample(nrow(scores))
    expect_equal(diag(scores)[perm], diagonal(scoresff, indices=perm))
    expect_error(diagonal(scores[1:10,1:8]))
  }

  if(require("bigmemory")){
    library(nat)
    scores=nblast(kcs20, kcs20)
    td=tempfile()
    on.exit(unlink(td, recursive = TRUE))
    scoresbm=as.big.matrix(scores, backingpath = td)
    expect_equal(diag(scores), diagonal(scoresbm))
    perm=sample(nrow(scores))
    expect_equal(diag(scores)[perm], diagonal(scoresbm, indices=perm))
  }
})