diff --git a/DESCRIPTION b/DESCRIPTION index ca79a060..c33882cc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -44,6 +44,7 @@ LinkingTo: RcppThread Suggests: doParallel, + iterators, knitr, rmarkdown, testthat @@ -60,6 +61,7 @@ LazyData: TRUE RoxygenNote: 7.3.1 Roxygen: list(markdown = TRUE) VignetteBuilder: knitr +Config/testthat/edition: 3 Collate: 'CENTROIDS-dba.R' 'CENTROIDS-pam.R' diff --git a/tests/testthat/helper-all.R b/tests/testthat/helper-all.R index c00380ea..946ac2d2 100644 --- a/tests/testthat/helper-all.R +++ b/tests/testthat/helper-all.R @@ -48,3 +48,27 @@ expect_equal_slots <- function(current, target, slots = c("cluster", "centroids" info = paste("slot =", object_slot)) } } + +expect_known_rds <- function(object, path, ..., info = NULL, update = TRUE) { + file <- if (missing(path)) paste0("rds/", rlang::enexpr(object)) else path + + if (!file.exists(file)) { + warning("Creating reference value", call. = FALSE) + saveRDS(object, file, version = 2) + succeed() + } + else { + ref_val <- readRDS(file) + comp <- compare(object, ref_val, ...) + if (update && !comp$equal) { + saveRDS(object, file, version = version) + } + expect(comp$equal, + sprintf("%s has changed from known value recorded in %s.\n%s", + file, + encodeString(file, quote = "'"), + comp$message), + info = info) + } + invisible(object) +} diff --git a/tests/testthat/unit/methods.R b/tests/testthat/test-01-unit-01-methods.R similarity index 99% rename from tests/testthat/unit/methods.R rename to tests/testthat/test-01-unit-01-methods.R index e2b23c46..6f8fbcd9 100644 --- a/tests/testthat/unit/methods.R +++ b/tests/testthat/test-01-unit-01-methods.R @@ -1,5 +1,3 @@ -context(" Generics for included classes") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/unit/misc.R b/tests/testthat/test-01-unit-02-misc.R similarity index 99% rename from tests/testthat/unit/misc.R rename to tests/testthat/test-01-unit-02-misc.R index f1093c4a..956e491c 100644 --- a/tests/testthat/unit/misc.R +++ b/tests/testthat/test-01-unit-02-misc.R @@ -1,5 +1,3 @@ -context(" Miscellaneous functions") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/unit/distances.R b/tests/testthat/test-01-unit-03-distances.R similarity index 99% rename from tests/testthat/unit/distances.R rename to tests/testthat/test-01-unit-03-distances.R index 3a637136..12bcc898 100644 --- a/tests/testthat/unit/distances.R +++ b/tests/testthat/test-01-unit-03-distances.R @@ -1,5 +1,3 @@ -context(" Included distances") - # ================================================================================================== # setup # ================================================================================================== @@ -213,7 +211,7 @@ test_that("dtw_lb gives the same result regardless of dtw.func.", { window.size = 15L, step.pattern = dtw::symmetric1) distmat_with_dtw <- dtw_lb(data_reinterpolated[1L:50L], data_reinterpolated[51L:100L], window.size = 15L, step.pattern = dtw::symmetric1, dtw.func = "dtw") - expect_equal(distmat_with_dtwbasic, distmat_with_dtw, check.attributes = FALSE) + expect_equal(distmat_with_dtwbasic, distmat_with_dtw, ignore_attr = TRUE) }) test_that("dtw_lb gives the same result for different nn.margin and corresponding inputs.", { diff --git a/tests/testthat/unit/centroids.R b/tests/testthat/test-01-unit-04-centroids.R similarity index 98% rename from tests/testthat/unit/centroids.R rename to tests/testthat/test-01-unit-04-centroids.R index 256cad2c..649a93b1 100644 --- a/tests/testthat/unit/centroids.R +++ b/tests/testthat/test-01-unit-04-centroids.R @@ -1,5 +1,3 @@ -context(" Centroids") - # ================================================================================================== # setup # ================================================================================================== @@ -192,7 +190,7 @@ test_that("Operations with pam centroid complete successfully.", { k = k, cent = x[c(1L,20L)], cl_old = 0L), - check.attributes = FALSE) + ignore_attr = TRUE) ## ---------------------------------------------------------- sparse non-symmetric pt_ctrl$symmetric <- FALSE @@ -212,7 +210,7 @@ test_that("Operations with pam centroid complete successfully.", { k = k, cent = x_mv[c(1L,20L)], cl_old = 0L), - check.attributes = FALSE) + ignore_attr = TRUE) ## ---------------------------------------------------------- refs assign("cent_pam", cent_pam, persistent) @@ -226,7 +224,7 @@ test_that("Operations with pam centroid complete successfully.", { expect_identical(attr(pam_cent_no_distmat, "series_id"), 7L) pam_cent_with_distmat <- pam_cent(x[6L:10L], distmat = dm) expect_identical(attr(pam_cent_with_distmat, "series_id"), 2L) - expect_equal(pam_cent_with_distmat, pam_cent_no_distmat, check.attributes = FALSE) + expect_equal(pam_cent_with_distmat, pam_cent_no_distmat, ignore_attr = TRUE) }) # ================================================================================================== diff --git a/tests/testthat/unit/cvis.R b/tests/testthat/test-01-unit-05-cvis.R similarity index 92% rename from tests/testthat/unit/cvis.R rename to tests/testthat/test-01-unit-05-cvis.R index 3092429d..92200ff5 100644 --- a/tests/testthat/unit/cvis.R +++ b/tests/testthat/test-01-unit-05-cvis.R @@ -1,5 +1,3 @@ -context(" CVIs") - # ================================================================================================== # setup # ================================================================================================== @@ -22,8 +20,16 @@ test_that("CVI calculations are consistent regardless of quantity or order of CV args = tsclust_args(dist = list(window.size = 18L)), seed = 123) - expect_warning(base_cvis <- cvi(pc_mv, rep(1L:4L, each = 5L), "valid")) - expect_warning(i_cvis <- cvi(pc_mv, type = "internal")) + expect_warning( + expect_warning( + base_cvis <- cvi(pc_mv, rep(1L:4L, each = 5L), "valid") + ) + ) + expect_warning( + expect_warning( + i_cvis <- cvi(pc_mv, type = "internal") + ) + ) e_cvis <- cvi(pc_mv, rep(1L:4L, each = 5L), type = "external") expect_identical(base_cvis, c(e_cvis, i_cvis)) @@ -43,12 +49,22 @@ test_that("CVI calculations are consistent regardless of quantity or order of CV # when missing elements pc_mv@distmat <- NULL - expect_warning(this_cvis <- cvi(pc_mv, type = "internal")) + expect_warning( + expect_warning( + this_cvis <- cvi(pc_mv, type = "internal") + ) + ) considered_cvis <- names(this_cvis) expect_true(all(base_cvis[considered_cvis] == this_cvis)) pc_mv@datalist <- list() - expect_warning(this_cvis <- cvi(pc_mv, type = "internal")) + expect_warning( + expect_warning( + expect_warning( + this_cvis <- cvi(pc_mv, type = "internal") + ) + ) + ) considered_cvis <- names(this_cvis) expect_true(all(base_cvis[considered_cvis] == this_cvis)) @@ -157,7 +173,11 @@ test_that("CVIs work also for hierarchical and TADPole", { distance = "gak", sigma = 100, window.size = 18L) - expect_warning(cvis_tadp <- cvi(tadp, labels_subset)) + expect_warning( + expect_warning( + cvis_tadp <- cvi(tadp, labels_subset) + ) + ) cvis_hc <- cvi(hc, labels_subset) # refs diff --git a/tests/testthat/unit/configs.R b/tests/testthat/test-01-unit-06-configs.R similarity index 99% rename from tests/testthat/unit/configs.R rename to tests/testthat/test-01-unit-06-configs.R index 32fce517..605cd241 100644 --- a/tests/testthat/unit/configs.R +++ b/tests/testthat/test-01-unit-06-configs.R @@ -1,5 +1,3 @@ -context(" Configs") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/test-01-unit.R b/tests/testthat/test-01-unit.R deleted file mode 100644 index 82e23f76..00000000 --- a/tests/testthat/test-01-unit.R +++ /dev/null @@ -1,6 +0,0 @@ -source("unit/methods.R", TRUE) -source("unit/misc.R", TRUE) -source("unit/distances.R", TRUE) -source("unit/centroids.R", TRUE) -source("unit/cvis.R", TRUE) -source("unit/configs.R", TRUE) diff --git a/tests/testthat/integration/proxy.R b/tests/testthat/test-02-integration-01-proxy.R similarity index 90% rename from tests/testthat/integration/proxy.R rename to tests/testthat/test-02-integration-01-proxy.R index 6768cebc..3259d600 100644 --- a/tests/testthat/integration/proxy.R +++ b/tests/testthat/test-02-integration-01-proxy.R @@ -1,5 +1,3 @@ -context(" Proxy distances") - # ================================================================================================== # setup # ================================================================================================== @@ -23,7 +21,7 @@ test_that("Included proxy distances can be called and give expected dimensions." d2 <- proxy::dist(x, x, method = distance, window.size = 15L, sigma = 100, normalize = TRUE) if (distance != "sdtw") { - expect_equal(unclass(d2), as.matrix(d), check.attributes = FALSE, + expect_equal(unclass(d2), as.matrix(d), ignore_attr = TRUE, info = paste(distance, "double-arg")) } @@ -38,9 +36,9 @@ test_that("Included proxy distances can be called and give expected dimensions." # dtw_lb will give different results below because of how it works if (distance == "dtw_lb") next - expect_equal(d3, d2[1L, , drop = FALSE], check.attributes = FALSE, + expect_equal(d3, d2[1L, , drop = FALSE], ignore_attr = TRUE, info = paste(distance, "one-vs-many-vs-distmat")) - expect_equal(d4, d2[ , 1L, drop = FALSE], check.attributes = FALSE, + expect_equal(d4, d2[ , 1L, drop = FALSE], ignore_attr = TRUE, info = paste(distance, "many-vs-one-vs-distmat")) dots <- list() @@ -59,7 +57,7 @@ test_that("Included proxy distances can be called and give expected dimensions." }) }) if (distance == "sdtw") diag(manual_distmat) <- 0 - expect_equal(as.matrix(d), manual_distmat, check.attributes = FALSE, + expect_equal(as.matrix(d), manual_distmat, ignore_attr = TRUE, info = paste("manual distmat vs proxy version using", distance)) } }) @@ -90,7 +88,7 @@ test_that("Included proxy distances can be called for pairwise = TRUE and give e expect_null(dim(d), paste("distance =", distance)) expect_identical(length(d), length(x), info = paste(distance, "pairwise single-arg")) if (distance != "sdtw") - expect_equal(d, rep(0, length(d)), check.attributes = FALSE, + expect_equal(d, rep(0, length(d)), ignore_attr = TRUE, info = paste(distance, "pairwise single all zero")) d2 <- proxy::dist(x, x, method = distance, @@ -100,7 +98,7 @@ test_that("Included proxy distances can be called for pairwise = TRUE and give e expect_null(dim(d2), paste("distance =", distance)) expect_identical(length(d2), length(x), info = paste(distance, "pairwise double-arg")) if (distance != "sdtw") - expect_equal(d, rep(0, length(d2)), check.attributes = FALSE, + expect_equal(d, rep(0, length(d2)), ignore_attr = TRUE, info = paste(distance, "pairwise double all zero")) expect_error(proxy::dist(x[1L:3L], x[4L:5L], method = distance, @@ -120,7 +118,7 @@ test_that("Included proxy similarities can be called and give expected dimension expect_identical(dim(d), c(length(x), length(x)), info = paste(distance, "single-arg")) d2 <- proxy::simil(x, x, method = distance, sigma = 100) - expect_equal(d2, d, check.attributes = FALSE, + expect_equal(d2, d, ignore_attr = TRUE, info = paste(distance, "double-arg")) d3 <- proxy::simil(x[1L], x, method = distance, sigma = 100) @@ -131,9 +129,9 @@ test_that("Included proxy similarities can be called and give expected dimension class(d4) <- c("matrix", "array") expect_identical(dim(d4), c(length(x), 1L), info = paste(distance, "many-vs-one")) - expect_equal(d3, d[1L, , drop = FALSE], check.attributes = FALSE, + expect_equal(d3, d[1L, , drop = FALSE], ignore_attr = TRUE, info = paste(distance, "one-vs-many-vs-distmat")) - expect_equal(d4, d[ , 1L, drop = FALSE], check.attributes = FALSE, + expect_equal(d4, d[ , 1L, drop = FALSE], ignore_attr = TRUE, info = paste(distance, "many-vs-one-vs-distmat")) } }) diff --git a/tests/testthat/integration/families.R b/tests/testthat/test-02-integration-02-families.R similarity index 87% rename from tests/testthat/integration/families.R rename to tests/testthat/test-02-integration-02-families.R index 6d8067f0..cef16424 100644 --- a/tests/testthat/integration/families.R +++ b/tests/testthat/test-02-integration-02-families.R @@ -1,5 +1,3 @@ -context(" Families and proxy distances") - # ================================================================================================== # setup # ================================================================================================== @@ -32,13 +30,13 @@ test_that("Operations with tsclustFamily@dist and lbk give expected results", { class(sub_distmat) <- c("matrix", "array") expect_equal(pdist, rep(0, length(pdist)), info = "Pairwise", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(whole_distmat, distmat, info = "Whole, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- tsclustFamily, with distmat ts_ctrl$distmat <- dtwclust:::Distmat$new(distmat = distmat, @@ -52,10 +50,10 @@ test_that("Operations with tsclustFamily@dist and lbk give expected results", { sub_distmat <- family@dist(x, centroids, window.size = window.size) expect_equal(whole_distmat, unclass(distmat), info = "Whole, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(unclass(sub_distmat), distmat[ , c(1L, 15L), drop = FALSE], - info = "Sub, with distmat", tolerance = 0, check.attributes = FALSE) + info = "Sub, with distmat", tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- ref assign("distmat_lbk", whole_distmat, persistent) @@ -77,10 +75,10 @@ test_that("Operations with tsclustFamily@dist and lbk give expected results", { whole_distmat <- base::as.matrix(family@dist(x)) expect_equal(whole_distmat, base::as.matrix(distmat), info = "Whole, sparse distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, base::as.matrix(distmat[ , c(1L, 15L), drop = FALSE]), - info = "Sub, sparse distmat", tolerance = 0, check.attributes = FALSE) + info = "Sub, sparse distmat", tolerance = 0, ignore_attr = TRUE) }) # ================================================================================================== @@ -102,13 +100,13 @@ test_that("Operations with tsclustFamily@dist and lbi give expected results", { class(sub_distmat) <- c("matrix", "array") expect_equal(pdist, rep(0, length(pdist)), info = "Pairwise", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(whole_distmat, distmat, info = "Whole, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- tsclustFamily, with distmat ts_ctrl$distmat <- dtwclust:::Distmat$new(distmat = distmat, @@ -122,10 +120,10 @@ test_that("Operations with tsclustFamily@dist and lbi give expected results", { sub_distmat <- family@dist(x, centroids, window.size = window.size) expect_equal(whole_distmat, unclass(distmat), info = "Whole, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(unclass(sub_distmat), distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- ref assign("distmat_lbi", whole_distmat, persistent) @@ -147,10 +145,10 @@ test_that("Operations with tsclustFamily@dist and lbi give expected results", { whole_distmat <- base::as.matrix(family@dist(x)) expect_equal(whole_distmat, base::as.matrix(distmat), info = "Whole, sparse distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, base::as.matrix(distmat[ , c(1L, 15L), drop = FALSE]), - info = "Sub, sparse distmat", tolerance = 0, check.attributes = FALSE) + info = "Sub, sparse distmat", tolerance = 0, ignore_attr = TRUE) }) # ================================================================================================== @@ -172,13 +170,13 @@ test_that("Operations with tsclustFamily@dist and sbd give expected results", { class(sub_distmat) <- c("matrix", "array") expect_equal(pdist, rep(0, length(pdist)), info = "Pairwise", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(whole_distmat, distmat, info = "Whole, NULL distmat", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(unclass(sub_distmat), distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, NULL distmat", - check.attributes = FALSE) + ignore_attr = TRUE) ## ---------------------------------------------------------- tsclustFamily, with distmat ts_ctrl$distmat <- dtwclust:::Distmat$new(distmat = distmat, @@ -192,10 +190,10 @@ test_that("Operations with tsclustFamily@dist and sbd give expected results", { sub_distmat <- family@dist(x, centroids) expect_equal(whole_distmat, unclass(distmat), info = "Whole, with distmat", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(unclass(sub_distmat), distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, with distmat", - check.attributes = FALSE) + ignore_attr = TRUE) ## ---------------------------------------------------------- ref assign("distmat_sbd", whole_distmat, persistent) @@ -217,10 +215,10 @@ test_that("Operations with tsclustFamily@dist and sbd give expected results", { whole_distmat <- base::as.matrix(family@dist(x)) expect_equal(whole_distmat, base::as.matrix(distmat), info = "Whole, sparse distmat", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(sub_distmat, base::as.matrix(distmat[ , c(1L, 15L), drop = FALSE]), - info = "Sub, sparse distmat", check.attributes = FALSE) + info = "Sub, sparse distmat", ignore_attr = TRUE) }) # ================================================================================================== @@ -242,12 +240,12 @@ test_that("Operations with tsclustFamily@dist and dtw_lb give expected results", class(pdist) <- NULL expect_equal(pdist, rep(0, length(pdist)), info = "Pairwise", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(whole_distmat, distmat, info = "Whole, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) - expect_equal(sub_distmat, sdm, tolerance = 0, check.attributes = FALSE) + expect_equal(sub_distmat, sdm, tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- tsclustFamily, with distmat ts_ctrl$distmat <- dtwclust:::Distmat$new(distmat = distmat, @@ -261,12 +259,12 @@ test_that("Operations with tsclustFamily@dist and dtw_lb give expected results", sub_distmat <- family@dist(x, centroids, window.size = window.size) expect_equal(whole_distmat, unclass(distmat), info = "Whole, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) sdm <- distmat[ , c(1L, 15L), drop = FALSE] dimnames(sdm) <- NULL expect_equal(sub_distmat, sdm, info = "Sub, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- ref assign("distmat_dtwlb", whole_distmat, persistent) @@ -291,13 +289,13 @@ test_that("Operations with tsclustFamily@dist and dtw give expected results", { class(sub_distmat) <- c("matrix", "array") expect_equal(pdist, rep(0, length(pdist)), info = "Pairwise", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(whole_distmat, distmat, info = "Whole, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- tsclustFamily, with distmat ts_ctrl$distmat <- dtwclust:::Distmat$new(distmat = distmat, @@ -311,10 +309,10 @@ test_that("Operations with tsclustFamily@dist and dtw give expected results", { sub_distmat <- family@dist(x, centroids, window.size = window.size) expect_equal(whole_distmat, unclass(distmat), info = "Whole, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- ref assign("distmat_dtw", whole_distmat, persistent) @@ -339,13 +337,13 @@ test_that("Operations with tsclustFamily@dist and dtw2 give expected results", { class(sub_distmat) <- c("matrix", "array") expect_equal(pdist, rep(0, length(pdist)), info = "Pairwise", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(whole_distmat, distmat, info = "Whole, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- tsclustFamily, with distmat ts_ctrl$distmat <- dtwclust:::Distmat$new(distmat = distmat, @@ -359,10 +357,10 @@ test_that("Operations with tsclustFamily@dist and dtw2 give expected results", { sub_distmat <- family@dist(x, centroids, window.size = window.size) expect_equal(whole_distmat, unclass(distmat), info = "Whole, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- ref assign("distmat_dtw2", whole_distmat, persistent) @@ -387,13 +385,13 @@ test_that("Operations with tsclustFamily@dist and dtw_basic give expected result class(sub_distmat) <- c("matrix", "array") expect_equal(pdist, rep(0, length(pdist)), info = "Pairwise", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(whole_distmat, distmat, info = "Whole, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- tsclustFamily, with distmat ts_ctrl$distmat <- dtwclust:::Distmat$new(distmat = distmat, @@ -407,10 +405,10 @@ test_that("Operations with tsclustFamily@dist and dtw_basic give expected result sub_distmat <- family@dist(x, centroids, window.size = window.size) expect_equal(whole_distmat, unclass(distmat), info = "Whole, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(unclass(sub_distmat), distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- ref assign("distmat_dtwb", whole_distmat, persistent) @@ -432,10 +430,10 @@ test_that("Operations with tsclustFamily@dist and dtw_basic give expected result whole_distmat <- base::as.matrix(family@dist(x)) expect_equal(whole_distmat, base::as.matrix(distmat), info = "Whole, sparse distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, base::as.matrix(distmat[ , c(1L, 15L), drop = FALSE]), - info = "Sub, sparse distmat", tolerance = 0, check.attributes = FALSE) + info = "Sub, sparse distmat", tolerance = 0, ignore_attr = TRUE) }) # ================================================================================================== @@ -459,13 +457,13 @@ test_that("Operations with tsclustFamily@dist and gak give expected results", { class(sub_distmat) <- c("matrix", "array") expect_equal(pdist, rep(0, length(pdist)), info = "Pairwise", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(whole_distmat, distmat, info = "Whole, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, NULL distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- tsclustFamily, with distmat ts_ctrl$distmat <- dtwclust:::Distmat$new(distmat = distmat, @@ -479,10 +477,10 @@ test_that("Operations with tsclustFamily@dist and gak give expected results", { sub_distmat <- family@dist(x, centroids, window.size = window.size, sigma = 100) expect_equal(whole_distmat, unclass(distmat), info = "Whole, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(unclass(sub_distmat), distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- ref assign("distmat_gak", whole_distmat, persistent) @@ -505,10 +503,10 @@ test_that("Operations with tsclustFamily@dist and gak give expected results", { whole_distmat <- base::as.matrix(family@dist(x)) expect_equal(whole_distmat, base::as.matrix(distmat), info = "Whole, sparse distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(sub_distmat, base::as.matrix(distmat[ , c(1L, 15L), drop = FALSE]), - info = "Sub, sparse distmat", tolerance = 0, check.attributes = FALSE) + info = "Sub, sparse distmat", tolerance = 0, ignore_attr = TRUE) }) # ================================================================================================== @@ -532,10 +530,10 @@ test_that("Operations with tsclustFamily@dist and sdtw give expected results", { expect_identical(length(pdist), length(x), info = "Pairwise") expect_equal(whole_distmat, distmat, info = "Whole, NULL distmat", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(sub_distmat, distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, NULL distmat", - check.attributes = FALSE) + ignore_attr = TRUE) ## ---------------------------------------------------------- tsclustFamily, with distmat ts_ctrl$distmat <- dtwclust:::Distmat$new(distmat = distmat, @@ -549,10 +547,10 @@ test_that("Operations with tsclustFamily@dist and sdtw give expected results", { sub_distmat <- family@dist(x, centroids) expect_equal(whole_distmat, unclass(distmat), info = "Whole, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) expect_equal(unclass(sub_distmat), distmat[ , c(1L, 15L), drop = FALSE], info = "Sub, with distmat", - tolerance = 0, check.attributes = FALSE) + tolerance = 0, ignore_attr = TRUE) ## ---------------------------------------------------------- ref assign("distmat_sdtw", whole_distmat, persistent) @@ -573,10 +571,10 @@ test_that("Operations with tsclustFamily@dist and sdtw give expected results", { whole_distmat <- base::as.matrix(family@dist(x)) expect_equal(whole_distmat, base::as.matrix(distmat), info = "Whole, sparse distmat", - check.attributes = FALSE) + ignore_attr = TRUE) expect_equal(sub_distmat, base::as.matrix(distmat[ , c(1L, 15L), drop = FALSE]), - info = "Sub, sparse distmat", check.attributes = FALSE) + info = "Sub, sparse distmat", ignore_attr = TRUE) }) # ================================================================================================== diff --git a/tests/testthat/integration/custom-dist.R b/tests/testthat/test-02-integration-03-custom-dist.R similarity index 89% rename from tests/testthat/integration/custom-dist.R rename to tests/testthat/test-02-integration-03-custom-dist.R index f5e4f349..34c08723 100644 --- a/tests/testthat/integration/custom-dist.R +++ b/tests/testthat/test-02-integration-03-custom-dist.R @@ -1,5 +1,3 @@ -context(" Custom proxy distances and tsclust") - # ================================================================================================== # setup # ================================================================================================== @@ -59,11 +57,12 @@ test_that("Calling tsclust after registering a custom distance works as expected pc_ndtw_par <- reset_nondeterministic(pc_ndtw_par) - expect_equivalent(pc_ndtw_par@distmat, - proxy::dist(data_subset, data_subset, method = "nDTW", - window.type = "slantedband", window.size = 18L, - open.begin = TRUE, open.end = TRUE, - step.pattern = asymmetric)) + expect_equal(pc_ndtw_par@distmat, + proxy::dist(data_subset, data_subset, method = "nDTW", + window.type = "slantedband", window.size = 18L, + open.begin = TRUE, open.end = TRUE, + step.pattern = asymmetric), + ignore_attr = TRUE) assign("pc_ndtw", pc_ndtw, persistent) assign("pc_ndtw_sym", pc_ndtw_sym, persistent) diff --git a/tests/testthat/test-02-integration.R b/tests/testthat/test-02-integration.R deleted file mode 100644 index 4eb16df2..00000000 --- a/tests/testthat/test-02-integration.R +++ /dev/null @@ -1,3 +0,0 @@ -source("integration/proxy.R", TRUE) -source("integration/families.R", TRUE) -source("integration/custom-dist.R", TRUE) diff --git a/tests/testthat/acceptance/dtwb.R b/tests/testthat/test-03-acceptance-01-dtwb.R similarity index 91% rename from tests/testthat/acceptance/dtwb.R rename to tests/testthat/test-03-acceptance-01-dtwb.R index 0cd567f1..ed70d37b 100644 --- a/tests/testthat/acceptance/dtwb.R +++ b/tests/testthat/test-03-acceptance-01-dtwb.R @@ -1,5 +1,3 @@ -context(" Consistency of dtw_basic") - # ================================================================================================== # setup # ================================================================================================== @@ -79,22 +77,22 @@ test_that("dtw_basic gives the same results as dtw/dtw2", { D1_L1 <- proxy::dist(CharTraj[31L:46L], CharTraj[71L:86L], method = "dtw") D2_L1 <- proxy::dist(CharTraj[31L:46L], CharTraj[71L:86L], method = "dtw_basic") - expect_equivalent(D1_L1, D2_L1, info = "dtw vs dtw_basic") + expect_equal(D1_L1, D2_L1, info = "dtw vs dtw_basic", ignore_attr = TRUE) D1_L2 <- proxy::dist(CharTraj[31L:46L], CharTraj[71L:86L], method = "dtw2") D2_L2 <- proxy::dist(CharTraj[31L:16L], CharTraj[71L:16L], method = "dtw_basic", norm = "L2") - expect_equivalent(D1_L1, D2_L1, info = "dtw2 vs dtw_basic") + expect_equal(D1_L1, D2_L1, info = "dtw2 vs dtw_basic", ignore_attr = TRUE) D1_L1 <- proxy::dist(CharTrajMV[31L:46L], CharTrajMV[71L:86L], method = "dtw", dist.method = "L1") D2_L1 <- proxy::dist(CharTrajMV[31L:46L], CharTrajMV[71L:86L], method = "dtw_basic") - expect_equivalent(D1_L1, D2_L1, info = "dtw vs dtw_basic (multivariate)") + expect_equal(D1_L1, D2_L1, info = "dtw vs dtw_basic (multivariate)", ignore_attr = TRUE) D1_L2 <- proxy::dist(CharTrajMV[31L:46L], CharTrajMV[71L:86L], method = "dtw2") D2_L2 <- proxy::dist(CharTrajMV[31L:16L], CharTrajMV[71L:16L], method = "dtw_basic", norm = "L2") - expect_equivalent(D1_L1, D2_L1, info = "dtw2 vs dtw_basic (multivariate)") + expect_equal(D1_L1, D2_L1, info = "dtw2 vs dtw_basic (multivariate)", ignore_attr = TRUE) }) # ================================================================================================== diff --git a/tests/testthat/acceptance/gak.R b/tests/testthat/test-03-acceptance-02-gak.R similarity index 90% rename from tests/testthat/acceptance/gak.R rename to tests/testthat/test-03-acceptance-02-gak.R index adbd0324..d1a419a3 100644 --- a/tests/testthat/acceptance/gak.R +++ b/tests/testthat/test-03-acceptance-02-gak.R @@ -1,5 +1,3 @@ -context(" Symmetric GAK") - # ================================================================================================== # setup # ================================================================================================== @@ -17,8 +15,8 @@ test_that("Symmetric univariate GAK distance gives expected results.", { D2 <- proxy::dist(data_subset, data_subset, method = "gak", window.size = 18L, sigma = sigma) D3 <- sapply(data_subset, GAK, y = data_subset[[1L]], window.size = 18L, sigma = sigma) - expect_equal(as.matrix(D1), unclass(D2), info = "single-double-arg", check.attributes = FALSE) - expect_equal(c(0, D1[1L:(length(D3) - 1L)]), D3, info = "manual-vs-proxy", check.attributes = FALSE) + expect_equal(as.matrix(D1), unclass(D2), info = "single-double-arg", ignore_attr = TRUE) + expect_equal(c(0, D1[1L:(length(D3) - 1L)]), D3, info = "manual-vs-proxy", ignore_attr = TRUE) }) test_that("Symmetric multivariate GAK distance gives expected results.", { @@ -27,8 +25,8 @@ test_that("Symmetric multivariate GAK distance gives expected results.", { D2 <- proxy::dist(data_multivariate, data_multivariate, method = "gak", window.size = 18L, sigma = sigma) D3 <- sapply(data_multivariate, GAK, y = data_multivariate[[1L]], window.size = 18L, sigma = sigma) - expect_equal(as.matrix(D1), unclass(D2), info = "single-double-arg", check.attributes = FALSE) - expect_equal(c(0, D1[1L:(length(D3) - 1L)]), D3, info = "manual-vs-proxy", check.attributes = FALSE) + expect_equal(as.matrix(D1), unclass(D2), info = "single-double-arg", ignore_attr = TRUE) + expect_equal(c(0, D1[1L:(length(D3) - 1L)]), D3, info = "manual-vs-proxy", ignore_attr = TRUE) }) # ================================================================================================== diff --git a/tests/testthat/acceptance/lbs.R b/tests/testthat/test-03-acceptance-03-lbs.R similarity index 99% rename from tests/testthat/acceptance/lbs.R rename to tests/testthat/test-03-acceptance-03-lbs.R index d7d0cd58..56a43443 100644 --- a/tests/testthat/acceptance/lbs.R +++ b/tests/testthat/test-03-acceptance-03-lbs.R @@ -1,5 +1,3 @@ -context(" Consistency of DTW lower bounds") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/acceptance/symmetric-proxy.R b/tests/testthat/test-03-acceptance-04-symmetric-proxy.R similarity index 97% rename from tests/testthat/acceptance/symmetric-proxy.R rename to tests/testthat/test-03-acceptance-04-symmetric-proxy.R index 836a5e1c..a71697d9 100644 --- a/tests/testthat/acceptance/symmetric-proxy.R +++ b/tests/testthat/test-03-acceptance-04-symmetric-proxy.R @@ -1,5 +1,3 @@ -context(" Load balancing for parallel symmetric proxy") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/test-03-acceptance.R b/tests/testthat/test-03-acceptance.R deleted file mode 100644 index eb39ed85..00000000 --- a/tests/testthat/test-03-acceptance.R +++ /dev/null @@ -1,4 +0,0 @@ -source("acceptance/dtwb.R", TRUE) -source("acceptance/gak.R", TRUE) -source("acceptance/lbs.R", TRUE) -source("acceptance/symmetric-proxy.R", TRUE) diff --git a/tests/testthat/system/invalid-inputs.R b/tests/testthat/test-04-system-01-invalid-inputs.R similarity index 99% rename from tests/testthat/system/invalid-inputs.R rename to tests/testthat/test-04-system-01-invalid-inputs.R index bc83e011..cd4274b5 100644 --- a/tests/testthat/system/invalid-inputs.R +++ b/tests/testthat/test-04-system-01-invalid-inputs.R @@ -1,5 +1,3 @@ -context(" Invalid inputs") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/system/data-formats.R b/tests/testthat/test-04-system-02-data-formats.R similarity index 98% rename from tests/testthat/system/data-formats.R rename to tests/testthat/test-04-system-02-data-formats.R index 9ce07a8f..d4f7df08 100644 --- a/tests/testthat/system/data-formats.R +++ b/tests/testthat/test-04-system-02-data-formats.R @@ -1,5 +1,3 @@ -context(" Data formats") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/system/preproc.R b/tests/testthat/test-04-system-03-preproc.R similarity index 98% rename from tests/testthat/system/preproc.R rename to tests/testthat/test-04-system-03-preproc.R index abf906f1..8aea8960 100644 --- a/tests/testthat/system/preproc.R +++ b/tests/testthat/test-04-system-03-preproc.R @@ -1,5 +1,3 @@ -context(" Preprocessing") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/system/fuzzy.R b/tests/testthat/test-04-system-04-fuzzy.R similarity index 99% rename from tests/testthat/system/fuzzy.R rename to tests/testthat/test-04-system-04-fuzzy.R index 19d8bfaf..ec93b306 100644 --- a/tests/testthat/system/fuzzy.R +++ b/tests/testthat/test-04-system-04-fuzzy.R @@ -1,5 +1,3 @@ -context(" Fuzzy") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/system/hierarchical.R b/tests/testthat/test-04-system-05-hierarchical.R similarity index 98% rename from tests/testthat/system/hierarchical.R rename to tests/testthat/test-04-system-05-hierarchical.R index e106e30d..a60190c2 100644 --- a/tests/testthat/system/hierarchical.R +++ b/tests/testthat/test-04-system-05-hierarchical.R @@ -1,5 +1,3 @@ -context(" Hierarchical") - # ================================================================================================== # setup # ================================================================================================== @@ -95,7 +93,7 @@ test_that("Hierarchical clustering works as expected.", { # ================================================================================================== test_that("A valid custom hierarchical function works as expected.", { - require(cluster) + suppressPackageStartupMessages(require(cluster)) hc_diana <- tsclust(data, type = "hierarchical", k = 20L, distance = "sbd", diff --git a/tests/testthat/system/partitional.R b/tests/testthat/test-04-system-06-partitional.R similarity index 99% rename from tests/testthat/system/partitional.R rename to tests/testthat/test-04-system-06-partitional.R index 6ecfb4f1..7232de8e 100644 --- a/tests/testthat/system/partitional.R +++ b/tests/testthat/test-04-system-06-partitional.R @@ -1,5 +1,3 @@ -context(" Partitional") - # ================================================================================================== # setup # ================================================================================================== diff --git a/tests/testthat/system/comparisons.R b/tests/testthat/test-04-system-07-comparisons.R similarity index 92% rename from tests/testthat/system/comparisons.R rename to tests/testthat/test-04-system-07-comparisons.R index 29ef4634..89dc0026 100644 --- a/tests/testthat/system/comparisons.R +++ b/tests/testthat/test-04-system-07-comparisons.R @@ -1,5 +1,3 @@ -context(" Compare clusterings") - # ================================================================================================== # setup # ================================================================================================== @@ -13,7 +11,7 @@ acf_fun <- function(dat, ...) { }) } -evaluators <- cvi_evaluators("VI", ground.truth = labels_subset) +evaluators <- suppressMessages(cvi_evaluators("VI", ground.truth = labels_subset)) score_fun <- evaluators$score pick_fun <- evaluators$pick type_score_fun <- list(fuzzy = score_fun) @@ -201,10 +199,12 @@ test_that("cvi_evaluators work nicely with compare_clusterings.", { ) # non-fuzzy - ev_valid <- cvi_evaluators("valid", ground.truth = labels_subset) - ev_internal <- cvi_evaluators("internal", ground.truth = labels_subset) - ev_external <- cvi_evaluators("external", ground.truth = labels_subset) - ev_vi <- cvi_evaluators("VI", ground.truth = labels_subset) + suppressMessages({ + ev_valid <- cvi_evaluators("valid", ground.truth = labels_subset) + ev_internal <- cvi_evaluators("internal", ground.truth = labels_subset) + ev_external <- cvi_evaluators("external", ground.truth = labels_subset) + ev_vi <- cvi_evaluators("VI", ground.truth = labels_subset) + }) # valid with_objs <- compare_clusterings(data_reinterpolated_subset, @@ -271,10 +271,12 @@ test_that("cvi_evaluators work nicely with compare_clusterings.", { expect_identical(with_objs$pick$config, without_objs$pick) # fuzzy - ev_valid <- cvi_evaluators("valid", TRUE, ground.truth = labels_subset) - ev_internal <- cvi_evaluators("internal", TRUE, ground.truth = labels_subset) - ev_external <- cvi_evaluators("external", TRUE, ground.truth = labels_subset) - ev_vi <- cvi_evaluators("VI", TRUE, ground.truth = labels_subset) + suppressMessages({ + ev_valid <- cvi_evaluators("valid", TRUE, ground.truth = labels_subset) + ev_internal <- cvi_evaluators("internal", TRUE, ground.truth = labels_subset) + ev_external <- cvi_evaluators("external", TRUE, ground.truth = labels_subset) + ev_vi <- cvi_evaluators("VI", TRUE, ground.truth = labels_subset) + }) # valid with_objs <- compare_clusterings(data_reinterpolated_subset, @@ -351,17 +353,23 @@ test_that("Compare clusterings works for the minimum set with all possibilities. )) errored_cfg$tadpole$window.size <- NULL expect_warning( - errored <- compare_clusterings(data_reinterpolated_subset, "t", errored_cfg, - .errorhandling = "pass", - score.clus = function(...) {}) + expect_warning( + errored <- compare_clusterings(data_reinterpolated_subset, "t", errored_cfg, + .errorhandling = "pass", + score.clus = function(...) {}) + ) ) expect_true(inherits(errored$scores$tadpole[[1L]], "error")) - expect_warning(errorpass_comp <- compare_clusterings(data_subset, c("p", "h", "f"), - configs = compare_clusterings_configs(k = 2L:3L), - seed = 932L, return.objects = TRUE, - .errorhandling = "pass"), - "names") + expect_warning( + expect_warning( + errorpass_comp <- compare_clusterings(data_subset, c("p", "h", "f"), + configs = compare_clusterings_configs(k = 2L:3L), + seed = 932L, return.objects = TRUE, + .errorhandling = "pass"), + "names" + ) + ) expect_true(inherits(errorpass_comp$objects.fuzzy[[1L]], "error")) @@ -414,14 +422,16 @@ test_that("Compare clusterings works for the minimum set with all possibilities. expect_identical(no_pick$results, type_score_objs$results) expect_output( - all_comparisons <- compare_clusterings(data_reinterpolated_subset, - c("p", "h", "f", "t"), - configs = cfgs, seed = 392L, - trace = TRUE, - score.clus = score_fun, - pick.clus = pick_fun, - return.objects = TRUE, - shuffle.configs = TRUE) + suppressMessages( + all_comparisons <- compare_clusterings(data_reinterpolated_subset, + c("p", "h", "f", "t"), + configs = cfgs, seed = 392L, + trace = TRUE, + score.clus = score_fun, + pick.clus = pick_fun, + return.objects = TRUE, + shuffle.configs = TRUE) + ) ) expect_equal_slots( diff --git a/tests/testthat/test-04-system-99-rng.R b/tests/testthat/test-04-system-99-rng.R new file mode 100644 index 00000000..fb7d455f --- /dev/null +++ b/tests/testthat/test-04-system-99-rng.R @@ -0,0 +1,3 @@ +test_that("The RNGkind was not affected by dtwclust.", { + expect_identical(RNGkind()[1L], default_rngkind) +}) diff --git a/tests/testthat/test-04-system.R b/tests/testthat/test-04-system.R deleted file mode 100644 index 0a3df96e..00000000 --- a/tests/testthat/test-04-system.R +++ /dev/null @@ -1,11 +0,0 @@ -source("system/invalid-inputs.R", TRUE) -source("system/data-formats.R", TRUE) -source("system/preproc.R", TRUE) -source("system/fuzzy.R", TRUE) -source("system/hierarchical.R", TRUE) -source("system/partitional.R", TRUE) -source("system/comparisons.R", TRUE) - -test_that("The RNGkind was not affected by dtwclust.", { - expect_identical(RNGkind()[1L], default_rngkind) -}) diff --git a/tests/testthat/regression/proxy.R b/tests/testthat/test-05-regression-01-proxy.R similarity index 96% rename from tests/testthat/regression/proxy.R rename to tests/testthat/test-05-regression-01-proxy.R index 6eeb9f28..e9fb7a47 100644 --- a/tests/testthat/regression/proxy.R +++ b/tests/testthat/test-05-regression-01-proxy.R @@ -1,5 +1,3 @@ -context(" Proxy distances") - # ================================================================================================= # setup # ================================================================================================= @@ -18,6 +16,8 @@ x <- data_reinterpolated[3L:8L] # ================================================================================================= test_that("Pairwise proxy distances give the same result as references", { + skip_on_cran() + local_edition(2) for (distance in included_distances) { d <- proxy::dist(x[1L:3L], x[4L:6L], method = distance, window.size = 15L, sigma = 100, @@ -34,6 +34,7 @@ test_that("Pairwise proxy distances give the same result as references", { test_that("Included (valid) distances can accept multivariate series.", { skip_on_cran() + local_edition(2) for (distance in c("dtw_basic", "gak")) { mv <- proxy::dist(data_multivariate, method = distance, diff --git a/tests/testthat/regression/dtwb.R b/tests/testthat/test-05-regression-02-dtwb.R similarity index 97% rename from tests/testthat/regression/dtwb.R rename to tests/testthat/test-05-regression-02-dtwb.R index 42dee785..21b5b87a 100644 --- a/tests/testthat/regression/dtwb.R +++ b/tests/testthat/test-05-regression-02-dtwb.R @@ -1,5 +1,3 @@ -context(" DTW basic") - # ================================================================================================= # setup # ================================================================================================= @@ -13,6 +11,7 @@ ols <- ls() test_that("Pairwise proxy distances give the same result as references", { skip_on_cran() + local_edition(2) D2_L1 <- proxy::dist(data[31L:46L], data[71L:86L], method = "dtw_basic") D2_L2 <- proxy::dist(data[31L:16L], data[71L:16L], method = "dtw_basic", norm = "L2") diff --git a/tests/testthat/regression/family-distmat.R b/tests/testthat/test-05-regression-03-family-distmat.R similarity index 97% rename from tests/testthat/regression/family-distmat.R rename to tests/testthat/test-05-regression-03-family-distmat.R index 184f502e..0bc25762 100644 --- a/tests/testthat/regression/family-distmat.R +++ b/tests/testthat/test-05-regression-03-family-distmat.R @@ -1,5 +1,3 @@ -context(" Families' distance matrices") - # ================================================================================================= # setup # ================================================================================================= @@ -14,6 +12,7 @@ ols <- ls() with(persistent, { test_that("Distance matrices calculated with families give the same results as references.", { skip_on_cran() + local_edition(2) expect_known_value(distmat_lbk, file_name(distmat_lbk), info = "LBK") expect_known_value(distmat_lbi, file_name(distmat_lbi), info = "LBI") diff --git a/tests/testthat/regression/family-centroids.R b/tests/testthat/test-05-regression-04-family-centroids.R similarity index 97% rename from tests/testthat/regression/family-centroids.R rename to tests/testthat/test-05-regression-04-family-centroids.R index 8c759553..db4e1866 100644 --- a/tests/testthat/regression/family-centroids.R +++ b/tests/testthat/test-05-regression-04-family-centroids.R @@ -1,5 +1,3 @@ -context(" Families' centroids") - # ================================================================================================= # setup # ================================================================================================= @@ -14,6 +12,7 @@ ols <- ls() with(persistent, { test_that("Centroids calculated with families give the same results as references.", { skip_on_cran() + local_edition(2) expect_known_value(cent_mean, file_name(cent_mean), info = "Univariate") expect_known_value(cent_mv_mean, file_name(cent_mv_mean), info = "Multivariate") @@ -34,6 +33,7 @@ with(persistent, { test_that("Centroids calculated with SDTWC families give the same results as references.", { skip_on_cran() skip_if(tolower(Sys.info()[["sysname"]]) == "windows" & isTRUE(as.logical(Sys.getenv("CI"))), "On Windows CI") + local_edition(2) expect_known_value(cent_sdtwc, file_name(cent_sdtwc), tolerance = 1e-6, info = "SDTWC Univariate") expect_known_value(cent_mv_sdtwc, file_name(cent_mv_sdtwc), info = "SDTWC Multivariate") diff --git a/tests/testthat/regression/custom-dist.R b/tests/testthat/test-05-regression-05-custom-dist.R similarity index 95% rename from tests/testthat/regression/custom-dist.R rename to tests/testthat/test-05-regression-05-custom-dist.R index 91542d31..1c187be6 100644 --- a/tests/testthat/regression/custom-dist.R +++ b/tests/testthat/test-05-regression-05-custom-dist.R @@ -1,5 +1,3 @@ -context(" Custom proxy distance with dtwclust") - # ================================================================================================= # setup # ================================================================================================= @@ -14,6 +12,7 @@ ols <- ls() with(persistent, { test_that("A custom distance in dtwclust give the same results as references.", { skip_on_cran() + local_edition(2) expect_known_value(pc_ndtw, file_name(pc_ndtw), info = "nDTW") expect_known_value(pc_ndtw_sym, file_name(pc_ndtw_sym), info = "Symmetric nDTW") diff --git a/tests/testthat/regression/cvis.R b/tests/testthat/test-05-regression-06-cvis.R similarity index 98% rename from tests/testthat/regression/cvis.R rename to tests/testthat/test-05-regression-06-cvis.R index 50ff96ef..fa14fda5 100644 --- a/tests/testthat/regression/cvis.R +++ b/tests/testthat/test-05-regression-06-cvis.R @@ -1,5 +1,3 @@ -context(" CVIs") - # ================================================================================================= # setup # ================================================================================================= @@ -14,6 +12,7 @@ ols <- ls() with(persistent, { test_that("CVIs give the same results as references.", { skip_on_cran() + local_edition(2) expect_known_value(base_cvis, file_name(base_cvis)) expect_known_value(internal_fcvis, file_name(internal_fcvis)) diff --git a/tests/testthat/regression/clusterings.R b/tests/testthat/test-05-regression-07-clusterings.R similarity index 97% rename from tests/testthat/regression/clusterings.R rename to tests/testthat/test-05-regression-07-clusterings.R index 454181cf..b0c53dea 100644 --- a/tests/testthat/regression/clusterings.R +++ b/tests/testthat/test-05-regression-07-clusterings.R @@ -1,5 +1,3 @@ -context(" Clusterings") - # ================================================================================================== # setup # ================================================================================================== @@ -14,6 +12,7 @@ ols <- ls() with(persistent, { test_that("Fuzzy clustering gives the same results as references.", { skip_on_cran() + local_edition(2) expect_known_value(fc_k, file_name(fc_k)) expect_known_value(fcm, file_name(fcm)) @@ -34,6 +33,7 @@ with(persistent, { with(persistent, { test_that("Hierarchical clustering gives the same results as references.", { skip_on_cran() + local_edition(2) expect_known_value(hc_k, file_name(hc_k)) expect_known_value(hc_all, file_name(hc_all)) @@ -51,6 +51,7 @@ with(persistent, { with(persistent, { test_that("Partitional clustering gives the same results as references.", { skip_on_cran() + local_edition(2) expect_known_value(pc_k, file_name(pc_k)) expect_known_value(pc_rep, file_name(pc_rep)) @@ -80,6 +81,7 @@ with(persistent, { test_that("Partitional clustering with SDTWC gives the same results as references.", { skip_on_cran() skip_if(tolower(Sys.info()[["sysname"]]) == "windows" & isTRUE(as.logical(Sys.getenv("CI"))), "On Windows CI") + local_edition(2) expect_known_value(pc_sdtw, file_name(pc_sdtw)) }) }) diff --git a/tests/testthat/regression/comparisons.R b/tests/testthat/test-05-regression-08-comparisons.R similarity index 96% rename from tests/testthat/regression/comparisons.R rename to tests/testthat/test-05-regression-08-comparisons.R index 63e5985b..3a1c9215 100644 --- a/tests/testthat/regression/comparisons.R +++ b/tests/testthat/test-05-regression-08-comparisons.R @@ -1,5 +1,3 @@ -context(" Compare clusterings") - # ================================================================================================= # setup # ================================================================================================= @@ -14,6 +12,7 @@ ols <- ls() with(persistent, { test_that("Compare clusterings gives the same results as references.", { skip_on_cran() + local_edition(2) expect_known_value(comp_all, file_name(comp_all)) expect_known_value(comp_gak, file_name(comp_gak)) diff --git a/tests/testthat/test-05-regression.R b/tests/testthat/test-05-regression.R deleted file mode 100644 index 46a70b2e..00000000 --- a/tests/testthat/test-05-regression.R +++ /dev/null @@ -1,10 +0,0 @@ -if (identical(Sys.getenv("NOT_CRAN"), "true")) { - source("regression/proxy.R", TRUE) - source("regression/dtwb.R", TRUE) - source("regression/family-distmat.R", TRUE) - source("regression/family-centroids.R", TRUE) - source("regression/custom-dist.R", TRUE) - source("regression/cvis.R", TRUE) - source("regression/clusterings.R", TRUE) - source("regression/comparisons.R", TRUE) -} diff --git a/tests/testthat/test-06-parallel.R b/tests/testthat/test-06-parallel.R index 79877ff0..d1b645df 100644 --- a/tests/testthat/test-06-parallel.R +++ b/tests/testthat/test-06-parallel.R @@ -36,6 +36,7 @@ test_that("Parallel computation gives the same results as sequential", { registerDoParallel(cl) # Filter excludes files that have "parallel" in them, otherwise it would be recursive + options(testthat.default_reporter = "summary") res <- test_dir("./", filter = "parallel", invert = TRUE) sapply(clusterEvalQ(cl, RNGkind()[1L]), function(current_rngkind) {