tests/testthat/test_ascendingCompatibility.R

In pneuvial/adjclust: Adjacency-Constrained Clustering of a Block-Diagonal Similarity Matrix

check_snp <- function() {
  if (!require("snpStats")) {
    skip("'snpStats' package not available")
  }
}

context("Ascending compatibility of the adjclust algorithm")

test_that("snpClust gives results identical to those of adjclust 0.3.0", {
  check_snp()
  ## Note: this test depends on external data (genotypes) and functions 
  ## (snpStats::ld) which may change over time
  ## skip_on_cran()
  
  pathname <- system.file("extdata", "res_adjclust_0.3.0.rds", package = "adjclust")
  prevfit <- readRDS(pathname)

  data("ld.example", package = "snpStats")
  h <- 100
  
  ld.ceph <- snpStats::ld(ceph.1mb, depth = h, stats = "R.squared")
  
  p <- ncol(ceph.1mb)
  nSamples <- nrow(ceph.1mb)
  h <- 100
  ceph.1mb[4,286]@.Data[1,1] <- as.raw(3) ## to avoid NaNs
  ld.ceph <- snpStats::ld(ceph.1mb, depth = h, stats = "R.squared", symmetric = TRUE)
  ld.ceph <- round(ld.ceph, digits = 10)
  
  ## diagonal elements are 0 
  expect_identical(unname(diag(ld.ceph)), rep(0, p))
  expect_message(snpClust(ld.ceph, h = 100), 
                 "Note: forcing the diagonal of the LD similarity matrix to be 1",
                 all = FALSE)
  
  diag(ld.ceph) <- rep(1, p)
  fit <- snpClust(ld.ceph, h = 100)
  expect_equal(cumsum(fit$height), prevfit$height, tolerance = 1e-5)
})