diff --git a/DESCRIPTION b/DESCRIPTION index b4602dc..f34991a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,7 +25,7 @@ Imports: grDevices, stats Suggests: - testthat, + testthat (>= 3.0.0), knitr, rmarkdown, covr @@ -41,4 +41,5 @@ License: GPL (>= 2) VignetteBuilder: knitr RoxygenNote: 7.1.1 Roxygen: list(markdown = TRUE, roclets=c('rd', 'collate', 'namespace')) +Config/testthat/edition: 3 Encoding: UTF-8 diff --git a/tests/testthat.R b/tests/testthat.R index ea2e7bc..907ec60 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,3 +1,3 @@ Sys.setenv("R_TESTS" = "") -if(require(testthat) & require(hts)) +if(require(testthat) && require(hts)) test_check("hts") diff --git a/tests/testthat/test-aggts.R b/tests/testthat/test-aggts.R index 610f766..7c3c758 100644 --- a/tests/testthat/test-aggts.R +++ b/tests/testthat/test-aggts.R @@ -1,19 +1,17 @@ # A unit test for aggts() function -context("Tests on input") -test_that("tests for a non-gts object", { +test_that("tests for a non-gts object (input)", { set.seed(1234) mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10)) - expect_that(aggts(mts), throws_error()) + expect_error(aggts(mts)) }) -context("Tests on output") -test_that("tests for a non-gts object", { +test_that("tests for a non-gts object (output)", { set.seed(1234) mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10)) node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3)) hts <- hts(mts, nodes = node.list) out <- dim(aggts(hts)) - expect_that(out, equals(c(50, 20))) + expect_identical(out, c(50L, 20L)) }) diff --git a/tests/testthat/test-combinef.R b/tests/testthat/test-combinef.R index 6715d01..4039110 100644 --- a/tests/testthat/test-combinef.R +++ b/tests/testthat/test-combinef.R @@ -1,18 +1,13 @@ # A unit test for combinef() function -context("Tests on inputs") - -test_that("tests for hts at the bottom level", { +test_that("tests for hts at the bottom level (inputs)", { set.seed(1234) mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10)) node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3)) - expect_that(combinef(mts, nodes = node.list, algorithms = "lu"), - throws_error()) + expect_error(combinef(mts, nodes = node.list, algorithms = "lu")) }) -context("Tests on outputs") - -test_that("tests for hts", { +test_that("tests for hts (outputs)", { set.seed(1234) mts <- ts(matrix(5 + sort(rnorm(50)), nrow = 5, ncol = 10)) node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3)) @@ -21,11 +16,11 @@ test_that("tests for hts", { out1 <- combinef(allf, nodes = node.list, keep = "bottom", algorithms = "lu") out2 <- combinef(allf, nodes = node.list, keep = "gts", algorithms = "lu") - expect_that(dim(out1), equals(c(5, 10))) + expect_identical(dim(out1), c(5L, 10L)) expect_true(is.hts(out2)) }) -test_that("tests for gts", { +test_that("tests for gts (outputs)", { set.seed(1234) mts <- ts(5 + matrix(sort(rnorm(270)), nrow = 10, ncol = 27), start = c(2001, 1), frequency = 12) @@ -36,6 +31,6 @@ test_that("tests for gts", { algorithms = "lu") out2 <- combinef(allts(gts), groups = g, keep = "gts", algorithms = "lu") - expect_that(dim(out1), equals(c(10, 27))) - expect_that(dim(out2$bts), equals(c(10, 27))) + expect_identical(dim(out1), c(10L, 27L)) + expect_identical(dim(out2$bts), c(10L, 27L)) }) diff --git a/tests/testthat/test-gts.R b/tests/testthat/test-gts.R index 626d7f4..ccb13c9 100644 --- a/tests/testthat/test-gts.R +++ b/tests/testthat/test-gts.R @@ -1,6 +1,4 @@ # A unit test for gts() function -context("Tests on output") - test_that("tests for labels", { set.seed(1234) mts <- ts(5 + matrix(sort(rnorm(2700)), nrow = 100, ncol = 27), @@ -8,7 +6,7 @@ test_that("tests for labels", { g <- matrix(c(rep(1:3, each = 9), rep(c(rep(1, 3), rep(2, 3), rep(3, 3)), 3), rep(1:3, 9)), nrow = 3, byrow = TRUE) output <- paste0("G", 1:3) - expect_that(names(gts(mts, g)$labels), equals(output)) + expect_named(gts(mts, g)$labels, output) }) test_that("tests for specified labels", { @@ -18,7 +16,7 @@ test_that("tests for specified labels", { g <- matrix(c(rep(1:3, each = 9), rep(c(rep(1, 3), rep(2, 3), rep(3, 3)), 3), rep(1:3, 9)), nrow = 3, byrow = TRUE) rownames(g) <- c("Sex", "Purpose", "Frames") - expect_that(names(gts(mts, g)$labels), equals(rownames(g))) + expect_named(gts(mts, g)$labels, rownames(g)) }) test_that("tests for gmatrix", { @@ -32,7 +30,7 @@ test_that("tests for gmatrix", { output <- gts(mts, g)$groups dimnames(output) <- NULL - expect_that(output, equals(gmat)) + expect_identical(output, gmat) }) test_that("tests for matrix with characters", { @@ -41,11 +39,11 @@ test_that("tests for matrix with characters", { start = c(2001, 1), frequency = 12) gchar <- matrix(c(rep("Male", 8), rep("Female", 8), rep(LETTERS[3:10], 2)), nrow = 2, byrow = TRUE) - g <- matrix(c(rep(1, 8), rep(2, 8), rep(1:8, 2)), nrow = 2, byrow = T) - gmat <- rbind(rep(1, 16), g, seq(1, 16)) + g <- matrix(c(rep(1L, 8L), rep(2L, 8L), rep(1:8, 2)), nrow = 2, byrow = TRUE) + gmat <- rbind(rep(1L, 16L), g, 1:16) class(gmat) <- "gmatrix" output <- gts(mts, gchar)$groups dimnames(output) <- NULL - expect_that(output, equals(gmat)) + expect_identical(output, gmat) }) diff --git a/tests/testthat/test-hts.R b/tests/testthat/test-hts.R index f234efb..9525625 100644 --- a/tests/testthat/test-hts.R +++ b/tests/testthat/test-hts.R @@ -1,12 +1,10 @@ # A unit test for hts() function -context("Tests on inputs") - test_that("tests for y as a mts", { set.seed(1234) sts <- ts(rnorm(100), start = c(2001, 1), frequency = 12) node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3)) - expect_that(hts(sts, node.list), throws_error()) + expect_error(hts(sts, node.list)) }) test_that("tests for node as a list", { @@ -14,15 +12,15 @@ test_that("tests for node as a list", { mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10)) node.mat <- matrix(1:10, nrow = 2, ncol = 5) - expect_that(hts(mts, node.mat), throws_error()) + expect_error(hts(mts, node.mat)) }) test_that("tests for node by default", { set.seed(1234) mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10)) - nodes <- list("Level 1" = 10) + nodes <- list("Level 1" = 10L) - expect_that(hts(mts)$nodes, equals(nodes)) + expect_identical(hts(mts)$nodes, nodes) }) test_that("tests for the root node not specified", { @@ -30,7 +28,7 @@ test_that("tests for the root node not specified", { mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10)) node.list <- list(c(2, 3, 1), c(2, 2, 1, 1, 1, 3)) - expect_that(hts(mts, node.list), throws_error()) + expect_error(hts(mts, node.list)) }) test_that("tests for the terminal nodes wrong", { @@ -38,7 +36,7 @@ test_that("tests for the terminal nodes wrong", { mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10)) node.list <- list(1, c(2, 3, 1), c(2, 2, 1, 2, 1, 3)) - expect_that(hts(mts, node.list), throws_error()) + expect_error(hts(mts, node.list)) }) test_that("tests for the middle nodes wrong", { @@ -46,19 +44,29 @@ test_that("tests for the middle nodes wrong", { mts <- ts(matrix(5 + sort(rnorm(500)), nrow = 50, ncol = 10)) node.list <- list(1, c(2, 4, 1), c(2, 2, 1, 1, 1, 3)) - expect_that(hts(mts, node.list), throws_error()) + expect_error(hts(mts, node.list)) }) -context("tests on output") - -test_that("tests for the gmatrix", { +test_that("tests for the gmatrix (output)", { node.list <- list(3, c(2, 3, 1), c(2, 2, 1, 1, 1, 3)) - g <- matrix(c(rep(1, 10), rep(1, 4), rep(2, 3), rep(3, 3), rep(1, 2), - rep(2, 2), seq(3, 5), rep(6, 3), seq(1, 10)), ncol = 10, - byrow = TRUE) + g <- matrix( + c( + rep(1L, 10L), + rep(1L, 4L), + rep(2L, 3L), + rep(3L, 3L), + rep(1L, 2L), + rep(2L, 2L), + 3:5, + rep(6L, 3L), + 1:10 + ), + ncol = 10, + byrow = TRUE + ) class(g) <- "gmatrix" output <- GmatrixH(node.list) dimnames(output) <- NULL - expect_that(output, equals(g)) + expect_identical(output, g) }) diff --git a/tests/testthat/test-smatrix.R b/tests/testthat/test-smatrix.R index 761ba3f..afcea40 100644 --- a/tests/testthat/test-smatrix.R +++ b/tests/testthat/test-smatrix.R @@ -6,7 +6,7 @@ test_that("tests for hts", { hts <- hts(mts, nodes = node.list) s <- 1/rowSums(smatrix(hts)) - expect_that(InvS4h(node.list), equals(s)) + expect_identical(InvS4h(node.list), s) }) test_that("tests for gts", { @@ -20,5 +20,5 @@ test_that("tests for gts", { out <- InvS4g(gts$groups) names(out) <- NULL - expect_that(out, equals(s)) + expect_identical(out, s) })