R Under development (unstable) (2024-09-21 r87186 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 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]
+     )))
+   }
+ }
> 
> proc.time()
   user  system elapsed 
   0.35    0.06    0.37