Nothing
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]
)))
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.