From 2485816e6cf6a5f7872b935d00411002cd357593 Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Mon, 3 Nov 2025 22:51:09 +0000 Subject: [PATCH 1/3] Increased data 'mdPatternDS' tests --- tests/testthat/test-smk-mdPatternDS.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-smk-mdPatternDS.R b/tests/testthat/test-smk-mdPatternDS.R index f00feb84..989fd06b 100644 --- a/tests/testthat/test-smk-mdPatternDS.R +++ b/tests/testthat/test-smk-mdPatternDS.R @@ -56,7 +56,7 @@ test_that("mdPatternDS: sample complete data.frame", { 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)) + 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) @@ -72,7 +72,7 @@ test_that("mdPatternDS: sample incomplete data.frame", { 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], "4") + expect_equal(rownames(res$pattern)[1], "6") expect_equal(rownames(res$pattern)[2], "1") expect_equal(rownames(res$pattern)[3], "") From cf61c2ba33f2087dbf3b135a708ca72494d74251 Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Tue, 4 Nov 2025 12:57:27 +0000 Subject: [PATCH 2/3] Added 'set.standard.disclosure.settings()' --- tests/testthat/test-arg-mdPatternDS.R | 2 ++ tests/testthat/test-smk-mdPatternDS.R | 2 ++ 2 files changed, 4 insertions(+) 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-smk-mdPatternDS.R b/tests/testthat/test-smk-mdPatternDS.R index f00feb84..4c2e4f92 100644 --- a/tests/testthat/test-smk-mdPatternDS.R +++ b/tests/testthat/test-smk-mdPatternDS.R @@ -14,6 +14,8 @@ context("mdPatternDS::smk::setup") +set.standard.disclosure.settings() + # # Tests # From da36ab8bc17caf6c7922c443ac2d75c5d4daf5bc Mon Sep 17 00:00:00 2001 From: Stuart Wheater Date: Tue, 4 Nov 2025 16:23:31 +0000 Subject: [PATCH 3/3] Updated 'mdPatternDS' tests --- tests/testthat/test-disc-mdPatternDS.R | 69 ++++++++++++++++++++++++++ tests/testthat/test-smk-mdPatternDS.R | 30 ++++++----- 2 files changed, 83 insertions(+), 16 deletions(-) create mode 100644 tests/testthat/test-disc-mdPatternDS.R 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 96c43772..6cbe0062 100644 --- a/tests/testthat/test-smk-mdPatternDS.R +++ b/tests/testthat/test-smk-mdPatternDS.R @@ -20,8 +20,8 @@ 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" @@ -56,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, 5.0, 6.0), v2 = c(6.0, 5.0, 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) @@ -70,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], "6") - 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")))