diff --git a/tests/testthat/test-arg-mdPatternDS.R b/tests/testthat/test-arg-mdPatternDS.R index f6b4f941..bea53d22 100644 --- a/tests/testthat/test-arg-mdPatternDS.R +++ b/tests/testthat/test-arg-mdPatternDS.R @@ -14,6 +14,8 @@ context("mdPatternDS::arg::setup") +set.standard.disclosure.settings() + # # Tests # diff --git a/tests/testthat/test-disc-mdPatternDS.R b/tests/testthat/test-disc-mdPatternDS.R new file mode 100644 index 00000000..055974cc --- /dev/null +++ b/tests/testthat/test-disc-mdPatternDS.R @@ -0,0 +1,69 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2025 ProPASS Consortium. All rights reserved. +# +# This program and the accompanying materials +# are made available under the terms of the GNU Public License v3.0. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . +#------------------------------------------------------------------------------- + +# +# Set up +# + +context("mdPatternDS::disc::setup") + +set.standard.disclosure.settings() + +# +# Tests +# + +context("mdPatternDS::disc::sample incomplete data.frame") +test_that("mdPatternDS: sample incomplete data.frame", { + x_val <- data.frame(v1 = c(0.0, NA, 2.0, 3.0, 4.0, 5.0, 6.0), v2 = c(6.0, 5.0, 4.0, 3.0, 2.0, 1.0, 0.0)) + x <- "x_val" + + res <- mdPatternDS(x) + + expect_length(res, 3) + expect_length(class(res), 1) + expect_true(all(class(res) %in% c("list"))) + expect_length(class(res$pattern), 2) + expect_true(all(class(res$pattern) %in% c("matrix", "array"))) + + expect_length(colnames(res$pattern), 3) + expect_equal(colnames(res$pattern)[1], "v2") + expect_equal(colnames(res$pattern)[2], "v1") + expect_equal(colnames(res$pattern)[3], "") + expect_length(rownames(res$pattern), 3) + expect_equal(rownames(res$pattern)[1], "6") + expect_equal(rownames(res$pattern)[2], "suppressed(<3)") + expect_equal(rownames(res$pattern)[3], "") + + expect_equal(res$pattern[1, 1], 1) + expect_equal(res$pattern[1, 2], 1) + expect_equal(res$pattern[1, 3], 0) + expect_true(is.na(res$pattern[2, 1])) + expect_true(is.na(res$pattern[2, 2])) + expect_true(is.na(res$pattern[2, 3])) + expect_true(is.na(res$pattern[3, 1])) + expect_true(is.na(res$pattern[3, 2])) + expect_true(is.na(res$pattern[3, 3])) + + expect_length(class(res$valid), 1) + expect_true(all(class(res$valid) %in% c("logical"))) + expect_false(res$valid) + expect_length(class(res$message), 1) + expect_true(all(class(res$message) %in% c("character"))) + expect_equal(res$message, "Invalid: some pattern counts below threshold (3) have been suppressed") +}) + +# +# Done +# + +context("mdPatternDS::disc::shutdown") + +context("mdPatternDS::disc::done") diff --git a/tests/testthat/test-smk-mdPatternDS.R b/tests/testthat/test-smk-mdPatternDS.R index f00feb84..6cbe0062 100644 --- a/tests/testthat/test-smk-mdPatternDS.R +++ b/tests/testthat/test-smk-mdPatternDS.R @@ -14,12 +14,14 @@ context("mdPatternDS::smk::setup") +set.standard.disclosure.settings() + # # Tests # -context("mdPatternDS::smk::sample complete data.frame") -test_that("mdPatternDS: sample complete data.frame", { +context("mdPatternDS::smk::sample 1 complete data.frame") +test_that("mdPatternDS: sample 1 complete data.frame", { x_val <- data.frame(v1 = c(0.0, 1.0, 2.0, 3.0, 4.0), v2 = c(4.0, 3.0, 2.0, 1.0, 0.0)) x <- "x_val" @@ -54,9 +56,10 @@ test_that("mdPatternDS: sample complete data.frame", { expect_equal(res$message, "Valid: all pattern counts meet disclosure requirements") }) -context("mdPatternDS::smk::sample incomplete data.frame") -test_that("mdPatternDS: sample incomplete data.frame", { - x_val <- data.frame(v1 = c(0.0, NA, 2.0, 3.0, 4.0), v2 = c(4.0, 3.0, 2.0, 1.0, 0.0)) + +context("mdPatternDS::smk::sample 2 complete data.frame") +test_that("mdPatternDS: sample 2 complete data.frame", { + x_val <- data.frame(v1 = c(0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0), v2 = c(9.0, 8.0, 7.0, 6.0, 5.0, 4.0, 3.0, 2.0, 1.0, 0.0)) x <- "x_val" res <- mdPatternDS(x) @@ -68,23 +71,20 @@ test_that("mdPatternDS: sample incomplete data.frame", { expect_true(all(class(res$pattern) %in% c("matrix", "array"))) expect_length(colnames(res$pattern), 3) - expect_equal(colnames(res$pattern)[1], "v2") - expect_equal(colnames(res$pattern)[2], "v1") + expect_equal(colnames(res$pattern)[1], "v1") + expect_equal(colnames(res$pattern)[2], "v2") expect_equal(colnames(res$pattern)[3], "") - expect_length(rownames(res$pattern), 3) - expect_equal(rownames(res$pattern)[1], "4") - expect_equal(rownames(res$pattern)[2], "1") - expect_equal(rownames(res$pattern)[3], "") + expect_length(rownames(res$pattern), 2) + expect_equal(rownames(res$pattern)[1], "10") + expect_equal(rownames(res$pattern)[2], "") + expect_true(is.na(rownames(res$pattern)[3])) expect_equal(res$pattern[1, 1], 1) expect_equal(res$pattern[1, 2], 1) expect_equal(res$pattern[1, 3], 0) - expect_equal(res$pattern[2, 1], 1) + expect_equal(res$pattern[2, 1], 0) expect_equal(res$pattern[2, 2], 0) - expect_equal(res$pattern[2, 3], 1) - expect_equal(res$pattern[3, 1], 0) - expect_equal(res$pattern[3, 2], 1) - expect_equal(res$pattern[3, 3], 1) + expect_equal(res$pattern[2, 3], 0) expect_length(class(res$valid), 1) expect_true(all(class(res$valid) %in% c("logical")))