tests/test-golub.R

In supc: The Self-Updating Process Clustering Algorithms

library(supc)
supc:::.set_num_threads(2)
data("golub", package = "supc")

check.cl <- function(supc.obj, cluster.tolerance = 1e-3) {
  if (is.null(supc.obj)) return(NULL)
  cl <- supc.obj$cluster
  r <- supc.obj$result
  for(i in seq_len(max(cl))) {
    . <- dist(r[cl == i,,drop = FALSE])
    if (length(.) > 0) {
      stopifnot(max(.) < cluster.tolerance)
    }
  }
}

if (Sys.getenv("TEST_GOLUB") == "TRUE") {
  print(system.time(
    golub.cpp <- tryCatch({
      supc1(golub, r = 4, t = "dynamic", implementation = "cpp", verbose = TRUE)
    }, error = function(e) {
      if (conditionMessage(e) == supc:::.check.compatibility.error.msg) NULL else stop(conditionMessage(e))
    })
  ))
  check.cl(golub.cpp)
  cat("===\n")
  print(system.time(
    golub.cpp2 <- tryCatch({
      supc1(golub, r = 4, t = "dynamic", implementation = "cpp2", verbose = TRUE)
    }, error = function(e) {
      if (conditionMessage(e) == supc:::.check.compatibility.error.msg) NULL else stop(conditionMessage(e))
    })
  ))
  check.cl(golub.cpp2)
  cat("===\n")
  print(system.time(
    golub.r <- supc1(golub, r = 4, t = "dynamic", implementation = "R", verbose = TRUE)
    ))
  check.cl(golub.r)
  if (!is.null(golub.cpp) & !is.null(golub.cpp2)) {
    stopifnot(isTRUE(all.equal(golub.cpp, golub.cpp2)))
    stopifnot(isTRUE(all.equal(golub.cpp, golub.r)))
    stopifnot(all(diff(golub.cpp$size) <= 0))
    stopifnot(all(diff(golub.cpp2$size) <= 0))
  }
  stopifnot(all(diff(golub.r$size) <= 0))
  cat("===\n")
  print(system.time(
    golub.random.r <- supc.random(golub, r = 4, t = "dynamic", k = 10, implementation = "R", verbose = TRUE)
  ))
  print(system.time(
    golub.random.cpp <- tryCatch({
      supc.random(golub, r = 4, t = "dynamic", k = 10, implementation = "cpp", verbose = TRUE, groups = golub.random.r$groups)
    }, error = function(e) {
      if (conditionMessage(e) == supc:::.check.compatibility.error.msg) NULL else stop(conditionMessage(e))
    })
  ))
  if (!is.null(golub.random.cpp)) {
    check.names.ref <- c("x", "r", "cluster", "centers", "size")
    stopifnot(isTRUE(all.equal(
      golub.random.r[check.names.ref],
      golub.random.cpp[check.names.ref]
    )))
  }
}