Add matched-null validation for cluster counts

DESCRIPTION

@@ -126,6 +126,7 @@ Suggests:
     loo,
     MASS,
     Matrix,
+    matchednull (>= 0.2.1),
     mclogit,
     mclust,
     metadat,

NAMESPACE

@@ -690,6 +690,7 @@ export(r2_zeroinflated)
 export(rmse)
 export(simulate_residuals)
 export(test_bf)
+export(test_clusters)
 export(test_likelihoodratio)
 export(test_lrt)
 export(test_performance)

NEWS.md

@@ -2,6 +2,10 @@
 
 ## Changes
 
+* New function `test_clusters()` uses the `matchednull` package to test whether
+  a selected cluster count exceeds what matched-null data with the same margins
+  and correlations would produce.
+
 * `check_group_variation()` now returns a numeric effect size of the grouping
   variable's predictive association strength.
 

R/test_clusters.R

@@ -0,0 +1,155 @@
+#' Test a clustering result against matched nulls
+#'
+#' `test_clusters()` compares the number of clusters selected from observed data
+#' with the numbers selected from matched-null versions of those data. The null
+#' data preserve the observed marginal distributions and correlation structure
+#' but contain no cluster structure by construction. This complements
+#' [`check_clusterstructure()`], which evaluates clustering tendency against a
+#' spatial-uniformity null. The matched-null comparison is implemented with
+#' [`matchednull::matched_null_test()`].
+#'
+#' @param x A numeric matrix or data frame with no missing or infinite values.
+#' @param cluster_function A function that takes a numeric matrix and returns one
+#'   number. By default, `mclust::Mclust()` selects the number of mixture
+#'   components by BIC.
+#' @param iterations Number of matched-null data sets to evaluate.
+#' @param n_max Maximum number of clusters considered by the default
+#'   `mclust::Mclust()` pipeline. Ignored when `cluster_function` is supplied.
+#' @param standardize Logical. If `TRUE`, variables are standardized before the
+#'   observed and matched-null cluster counts are computed.
+#' @param ... Additional arguments passed to
+#'   [`matchednull::matched_null_test()`], such as `copula`, `df`, `probs`,
+#'   `ridge`, or `parallel`.
+#'
+#' @return An object of class `"test_clusters"` and `"matched_null_test"`. It
+#'   contains the observed statistic (`real`), matched-null statistics (`null`),
+#'   null interval (`interval`), one-sided Monte Carlo p-value (`p_exceed`), and
+#'   interval verdict (`within`).
+#'
+#' @details
+#' The default cluster-count pipeline fits Gaussian mixture models for one to
+#' `n_max` components and returns the BIC-selected count. A custom
+#' `cluster_function` receives the same preprocessed data as the default
+#' pipeline and must return one non-missing number.
+#'
+#' The Gaussian matched null tests for structure beyond the observed margins
+#' and correlations; rejection alone does not establish the existence of
+#' discrete types. When tail dependence is plausible, rerun the test with
+#' `copula = "t"` as a sensitivity analysis.
+#'
+#' @examplesIf requireNamespace("matchednull", quietly = TRUE) && requireNamespace("mclust", quietly = TRUE)
+#' \donttest{
+#' set.seed(42)
+#' test_clusters(iris[, 1:4], iterations = 19, n_max = 4)
+#'
+#' # Any scalar-returning clustering pipeline can be tested.
+#' pick_two <- function(data) 2
+#' test_clusters(iris[, 1:4], cluster_function = pick_two, iterations = 19)
+#' }
+#'
+#' @references
+#' Meng, M. (2026). Types Without Taxa: A Covariance-Matched-Null Multiverse
+#' Test of Categorical Versus Continuous Personality Structure. Manuscript
+#' under review. \doi{10.17605/OSF.IO/2EKCG}
+#'
+#' @seealso [`matchednull::matched_null_test()`],
+#'   [`check_clusterstructure()`]
+#' @export
+test_clusters <- function(
+  x,
+  cluster_function = NULL,
+  iterations = 200,
+  n_max = 10,
+  standardize = TRUE,
+  ...
+) {
+  insight::check_if_installed("matchednull", minimum_version = "0.2.1")
+
+  if (!is.logical(standardize) || length(standardize) != 1L || is.na(standardize)) {
+    insight::format_error("`standardize` must be `TRUE` or `FALSE`.")
+  }
+  if (!is.null(cluster_function) && !is.function(cluster_function)) {
+    insight::format_error("`cluster_function` must be a function or `NULL`.")
+  }
+  uses_default <- is.null(cluster_function)
+  if (!.is_positive_integer(iterations)) {
+    insight::format_error("`iterations` must be a positive integer.")
+  }
+  if (uses_default && !.is_positive_integer(n_max)) {
+    insight::format_error("`n_max` must be a positive integer.")
+  }
+
+  x <- .validate_test_clusters_data(x)
+  x <- .standardize_test_clusters_data(x, standardize)
+
+  if (uses_default) {
+    insight::check_if_installed("mclust")
+    mclustBIC <- mclust::mclustBIC
+    max_components <- min(as.integer(n_max), nrow(x) - 1L)
+    cluster_function <- function(data) {
+      mclust::Mclust(
+        data,
+        G = seq_len(max_components),
+        verbose = FALSE
+      )$G
+    }
+  }
+
+  out <- matchednull::matched_null_test(
+    x,
+    cluster_fn = cluster_function,
+    R = as.integer(iterations),
+    ...
+  )
+
+  attr(out, "standardize") <- standardize
+  attr(out, "n_max") <- if (uses_default) max_components else NULL
+  class(out) <- c("test_clusters", class(out))
+  out
+}
+
+
+.validate_test_clusters_data <- function(x) {
+  if (!is.matrix(x) && !is.data.frame(x)) {
+    insight::format_error("`x` must be a numeric matrix or data frame.")
+  }
+  if (is.data.frame(x) && !all(vapply(x, is.numeric, logical(1)))) {
+    insight::format_error("All columns in `x` must be numeric.")
+  }
+
+  x <- as.matrix(x)
+  if (!is.numeric(x)) {
+    insight::format_error("`x` must contain only numeric values.")
+  }
+  if (nrow(x) < 2L || ncol(x) < 1L) {
+    insight::format_error("`x` must contain at least two rows and one column.")
+  }
+  if (anyNA(x) || !all(is.finite(x))) {
+    insight::format_error("`x` must not contain missing or infinite values.")
+  }
+  x
+}
+
+
+.standardize_test_clusters_data <- function(x, standardize) {
+  if (!standardize) {
+    return(x)
+  }
+
+  column_sd <- apply(x, 2L, stats::sd)
+  if (!all(is.finite(column_sd)) || any(column_sd == 0)) {
+    insight::format_error(
+      "`x` cannot contain constant columns when `standardize = TRUE`."
+    )
+  }
+  scale(x)
+}
+
+
+.is_positive_integer <- function(x) {
+  is.numeric(x) &&
+    length(x) == 1L &&
+    !is.na(x) &&
+    x >= 1L &&
+    x %% 1 == 0
+}

inst/WORDLIST

@@ -155,6 +155,7 @@ Matuschek
 McElreath
 McKelvey
 Mehrvarz
+Meng
 Merkle
 Methoden
 Michalos

tests/testthat/test-test_clusters.R

@@ -0,0 +1,89 @@
+test_that("test_clusters supports a custom cluster function", {
+  skip_if_not_installed("matchednull", minimum_version = "0.2.1")
+
+  set.seed(12)
+  x <- matrix(rnorm(120), ncol = 3)
+  out <- test_clusters(
+    x,
+    cluster_function = function(data) 2,
+    iterations = 9
+  )
+
+  expect_s3_class(out, "test_clusters")
+  expect_s3_class(out, "matched_null_test")
+  expect_identical(out$real, 2)
+  expect_length(out$null, 9)
+  expect_true(out$within)
+  expect_true(attr(out, "standardize"))
+  expect_null(attr(out, "n_max"))
+  expect_output(print(out), "Matched-null test")
+
+  out_t <- test_clusters(
+    x,
+    cluster_function = function(data) 2,
+    iterations = 3,
+    copula = "t",
+    df = 4
+  )
+  expect_identical(out_t$copula, "t")
+  expect_identical(out_t$df, 4)
+})
+
+
+test_that("test_clusters is reproducible from a seed", {
+  skip_if_not_installed("matchednull", minimum_version = "0.2.1")
+
+  set.seed(3)
+  x <- matrix(rnorm(180), ncol = 3)
+  cluster_summary <- function(data) sum(data[1:5, 1])
+
+  set.seed(11)
+  out1 <- test_clusters(x, cluster_summary, iterations = 9)
+  set.seed(11)
+  out2 <- test_clusters(x, cluster_summary, iterations = 9)
+
+  expect_identical(out1$null, out2$null)
+  expect_gt(stats::var(out1$null), 0)
+})
+
+
+test_that("default mclust pipeline distinguishes null and positive controls", {
+  skip_if_not_installed("matchednull", minimum_version = "0.2.1")
+  skip_if_not_installed("mclust")
+
+  set.seed(42)
+  x_null <- matrix(rnorm(150 * 4), 150, 4) %*%
+    chol(diag(4) * 0.5 + 0.5)
+  set.seed(7)
+  null_result <- test_clusters(x_null, iterations = 9, n_max = 4)
+  expect_true(null_result$within)
+  expect_identical(attr(null_result, "n_max"), 4L)
+
+  set.seed(42)
+  group <- sample.int(2, 150, replace = TRUE)
+  x_positive <- matrix(rnorm(150 * 4), 150, 4)
+  positive_correlation <- chol(matrix(c(1, 0.9, 0.9, 1), 2, 2))
+  negative_correlation <- chol(matrix(c(1, -0.9, -0.9, 1), 2, 2))
+  x_positive[group == 1, 1:2] <- x_positive[group == 1, 1:2] %*% positive_correlation
+  x_positive[group == 1, 3:4] <- x_positive[group == 1, 3:4] %*% positive_correlation
+  x_positive[group == 2, 1:2] <- x_positive[group == 2, 1:2] %*% negative_correlation
+  x_positive[group == 2, 3:4] <- x_positive[group == 2, 3:4] %*% negative_correlation
+
+  set.seed(7)
+  positive_result <- test_clusters(x_positive, iterations = 9, n_max = 4)
+  expect_gt(positive_result$real, positive_result$interval[2])
+})
+
+
+test_that("test_clusters validates its inputs", {
+  skip_if_not_installed("matchednull", minimum_version = "0.2.1")
+
+  x <- matrix(rnorm(40), ncol = 2)
+  expect_error(test_clusters(1:10), "matrix or data frame")
+  expect_error(test_clusters(data.frame(x = 1:3, y = letters[1:3])), "numeric")
+  expect_error(test_clusters(cbind(x, NA_real_)), "missing or infinite")
+  expect_error(test_clusters(cbind(x, 1)), "constant columns")
+  expect_error(test_clusters(x, cluster_function = 1), "must be a function")
+  expect_error(test_clusters(x, iterations = 1.5), "positive integer")
+  expect_error(test_clusters(x, n_max = 0), "positive integer")
+})