tests/testthat/test-corrSelect.R

library(testthat)

test_that("corrSelect returns CorrCombo with numeric data", {
  df <- data.frame(A = rnorm(10), B = rnorm(10), C = rnorm(10))
  res <- corrSelect(df, threshold = 0.5, method = "els")
  expect_true(inherits(res, "CorrCombo"))
})

test_that("fails when only one numeric column remains after skipping", {
  df <- data.frame(x = rnorm(5), y = letters[1:5], z = factor(1:5))
  expect_error(corrSelect(df, threshold = 0.5, method = "els"))
})

test_that("matrix input is converted to data.frame", {
  mat <- matrix(rnorm(100), ncol = 10)
  expect_true(inherits(corrSelect(mat, threshold = 0.5, method = "els"), "CorrCombo"))
})

test_that("fails with fewer than two columns", {
  df <- data.frame(x = rnorm(10))
  expect_error(corrSelect(df, threshold = 0.5, method = "els"), "at least two")
})

test_that("fails if fewer than two numeric columns remain", {
  df <- data.frame(a = factor(1:5), b = letters[1:5])
  expect_error(corrSelect(df, threshold = 0.5, method = "els"), "Less than two numeric")
})

test_that("force_in accepts column names", {
  df <- data.frame(a = rnorm(10), b = rnorm(10), c = rnorm(10))
  res <- corrSelect(df, threshold = 0.9, method = "els", force_in = c("a", "b"))
  expect_true(all(c("a", "b") %in% unlist(res@subset_list)))
})

test_that("invalid force_in names trigger error", {
  df <- data.frame(a = rnorm(10), b = rnorm(10))
  expect_error(corrSelect(df, threshold = 0.9, method = "els", force_in = "z"), "not in the data frame")
})

test_that("works with NAs (rows are dropped)", {
  df <- data.frame(a = c(1, 2, NA, 4), b = c(NA, 2, 3, 4), c = c(4, 3, 2, 1))
  expect_warning(res <- corrSelect(df, threshold = 0.9, method = "els"), "Removed")
  expect_true(inherits(res, "CorrCombo"))
})

test_that("bron-kerbosch with use_pivot = FALSE runs", {
  df <- data.frame(A = rnorm(10), B = rnorm(10), C = rnorm(10))
  res <- corrSelect(df, threshold = 0.7, method = "bron-kerbosch", use_pivot = FALSE)
  expect_true(inherits(res, "CorrCombo"))
  expect_equal(res@search_type, "bron-kerbosch")
})

test_that("correct properties are filled", {
  df <- data.frame(x = rnorm(10), y = rnorm(10))
  res <- corrSelect(df, threshold = 0.5, method = "els")
  expect_equal(
    names(S7::props(res)),
    c("subset_list", "avg_corr", "min_corr", "max_corr",
      "var_names", "threshold", "forced_in", "search_type", "cor_method", "n_rows_used")
  )
})

test_that("min and max correlations are valid", {
  df <- data.frame(x = rnorm(10), y = rnorm(10), z = rnorm(10))
  res <- corrSelect(df, threshold = 0.5, method = "els")
  expect_length(res@min_corr, length(res@subset_list))
  expect_true(all(res@max_corr >= res@min_corr, na.rm = TRUE))
})

test_that("works with tibble-like input", {
  skip_if_not_installed("tibble")
  df <- as.data.frame(tibble::tibble(x = rnorm(5), y = rnorm(5)))
  res <- corrSelect(df, threshold = 0.9, method = "els")
  expect_true(inherits(res, "CorrCombo"))
})

test_that("force_in accepts numeric indices", {
  set.seed(1234)
  df <- data.frame(x = rnorm(10), y = rnorm(10), z = rnorm(10))
  res <- corrSelect(df, threshold = 0.8, method = "els", force_in = c(1, 3))
  expect_true(all(c("x", "z") %in% unlist(res@subset_list)))
})

test_that("returns subsets when correlation is below threshold", {
  set.seed(999)
  # Create two nearly uncorrelated variables
  df <- data.frame(x = rnorm(100), y = rnorm(100))
  res <- corrSelect(df, threshold = 0.5, method = "els")

  # When correlation is low (below threshold), both variables CAN be in the same subset
  expect_true(inherits(res, "CorrCombo"))
  # Should have at least one subset containing both variables
  expect_gte(length(res@subset_list), 1)
})

test_that("returns size-1 subsets when all pairs exceed threshold", {
  # Create perfectly correlated variables
  x <- 1:10
  y <- x  # Perfect correlation
  df <- data.frame(x = x, y = y)
  res <- corrSelect(df, threshold = 0.5, method = "els")

  # With r = 1.0 and threshold = 0.5, no pair meets threshold, so the only
  # maximal subsets are "x" and "y" on their own (see #30).
  expect_true(inherits(res, "CorrCombo"))
  expect_length(res@subset_list, 2)
  expect_true(all(vapply(res@subset_list, length, integer(1)) == 1))
})


test_that("additional args via ... are accepted", {
  df <- data.frame(x = rnorm(10), y = rnorm(10), z = rnorm(10))
  res <- corrSelect(df, threshold = 0.5, method = "bron-kerbosch", use_pivot = TRUE)
  expect_true(inherits(res, "CorrCombo"))
})

test_that("corrSelect works with cor_method = 'pearson'", {
  df <- data.frame(a = rnorm(10), b = rnorm(10), c = rnorm(10))
  res <- corrSelect(df, threshold = 0.8, cor_method = "pearson")
  expect_true(inherits(res, "CorrCombo"))
  expect_equal(res@cor_method, "pearson")
})

test_that("corrSelect works with cor_method = 'spearman'", {
  df <- data.frame(a = rnorm(10), b = runif(10), c = rnorm(10))
  res <- corrSelect(df, threshold = 0.8, cor_method = "spearman")
  expect_true(inherits(res, "CorrCombo"))
  expect_equal(res@cor_method, "spearman")
})

test_that("corrSelect works with cor_method = 'kendall'", {
  df <- data.frame(a = rnorm(10), b = rnorm(10), c = rnorm(10))
  res <- corrSelect(df, threshold = 0.8, cor_method = "kendall")
  expect_true(inherits(res, "CorrCombo"))
  expect_equal(res@cor_method, "kendall")
})

test_that("corrSelect works with cor_method = 'bicor' if WGCNA is available", {
  skip_if_not_installed("WGCNA")
  df <- data.frame(a = rnorm(20), b = rnorm(20), c = rnorm(20))
  res <- corrSelect(df, threshold = 0.8, cor_method = "bicor")
  expect_true(inherits(res, "CorrCombo"))
  expect_equal(res@cor_method, "bicor")
})

test_that("corrSelect works with cor_method = 'distance' if energy is available", {
  skip_if_not_installed("energy")
  df <- data.frame(a = rnorm(15), b = rnorm(15), c = rnorm(15))
  res <- corrSelect(df, threshold = 0.8, cor_method = "distance")
  expect_true(inherits(res, "CorrCombo"))
  expect_equal(res@cor_method, "distance")
})

test_that("corrSelect works with cor_method = 'maximal' if minerva is available", {
  skip_if_not_installed("minerva")
  df <- data.frame(a = rnorm(12), b = rnorm(12), c = rnorm(12))
  res <- corrSelect(df, threshold = 0.8, cor_method = "maximal")
  expect_true(inherits(res, "CorrCombo"))
  expect_equal(res@cor_method, "maximal")
})
test_that("can get more than one combination (named columns)", {
  # Build a 4×4 correlation matrix with names
  cor_mat <- matrix(0.9, nrow = 4, ncol = 4)
  diag(cor_mat) <- 1
  cor_mat[1,2] <- cor_mat[2,1] <- 0.1
  cor_mat[3,4] <- cor_mat[4,3] <- 0.1
  colnames(cor_mat) <- paste0("V", 1:4)
  rownames(cor_mat) <- colnames(cor_mat)

  # Run BK
  res <- MatSelect(cor_mat, threshold = 0.5, method = "bron-kerbosch", use_pivot = TRUE)

  # Expect exactly two subsets, named "V1","V2" and "V3","V4"
  expect_equal(length(res@subset_list), 2L)

  # Extract the subset names
  subsets <- res@subset_list
  # Sort each for comparison
  subsets <- lapply(subsets, sort)

  # The two expected sets
  expected <- list(c("V1","V2"), c("V3","V4"))

  # Check that each expected set appears in the output
  for (exp in expected) {
    found <- any(vapply(subsets, function(x) identical(x, exp), logical(1)))
    expect_true(found, info = paste("Missing subset", paste(exp, collapse=",")))
  }
})
test_that("ELS can get more than one combination (named columns)", {
  # Build a 4×4 correlation matrix with names
  cor_mat <- matrix(0.9, nrow = 4, ncol = 4)
  diag(cor_mat) <- 1
  cor_mat[1,2] <- cor_mat[2,1] <- 0.1
  cor_mat[3,4] <- cor_mat[4,3] <- 0.1
  colnames(cor_mat) <- paste0("V", 1:4)
  rownames(cor_mat) <- colnames(cor_mat)

  # Run ELS
  res <- MatSelect(cor_mat, threshold = 0.5, method = "els")

  res# Expect exactly two subsets, named "V1","V2" and "V3","V4"
  expect_equal(length(res@subset_list), 2L)

  # Extract the subset names
  subsets <- res@subset_list
  subsets <- lapply(subsets, sort)

  # The two expected sets
  expected <- list(c("V1","V2"), c("V3","V4"))

  # Check that each expected set appears in the output
  for (exp in expected) {
    found <- any(vapply(subsets, function(x) identical(x, exp), logical(1)))
    expect_true(found, info = paste("ELS missing subset", paste(exp, collapse = ",")))
  }
})

# ============================================================================
# Edge case tests (reviewer request)
# ============================================================================

test_that("identity matrix returns single subset with all variables", {

  # Pure identity matrix: all off-diagonal correlations = 0

  # All variables are uncorrelated, so the only maximal subset is all variables
  n <- 5
  identity_mat <- diag(n)
  colnames(identity_mat) <- paste0("V", 1:n)
  rownames(identity_mat) <- colnames(identity_mat)


  # Test with Bron-Kerbosch
  res_bk <- MatSelect(identity_mat, threshold = 0.5, method = "bron-kerbosch")
  expect_equal(length(res_bk@subset_list), 1L)
  expect_equal(sort(res_bk@subset_list[[1]]), paste0("V", 1:n))

  # Test with ELS
  res_els <- MatSelect(identity_mat, threshold = 0.5, method = "els")
  expect_equal(length(res_els@subset_list), 1L)
  expect_equal(sort(res_els@subset_list[[1]]), paste0("V", 1:n))

  # Both algorithms should agree
  expect_setequal(res_bk@subset_list[[1]], res_els@subset_list[[1]])
})

test_that("perfect duplicate (r=1.0) variables are separated into different subsets", {
  # Two perfectly correlated variables (r = 1.0) should never appear together

  # in the same subset when threshold < 1.0
  n <- 4
  cor_mat <- diag(n)
  # V1 and V2 are perfectly correlated

  cor_mat[1, 2] <- cor_mat[2, 1] <- 1.0
  # V3 and V4 are uncorrelated with everything
  colnames(cor_mat) <- paste0("V", 1:n)
  rownames(cor_mat) <- colnames(cor_mat)

  # With threshold = 0.9, V1 and V2 should be in different subsets
  res_bk <- MatSelect(cor_mat, threshold = 0.9, method = "bron-kerbosch")

  # Check that V1 and V2 never appear in the same subset
  for (subset in res_bk@subset_list) {
    both_present <- all(c("V1", "V2") %in% subset)
    expect_false(both_present,
      info = "V1 and V2 (r=1.0) should not appear in the same subset")
  }

  # Same test with ELS

  res_els <- MatSelect(cor_mat, threshold = 0.9, method = "els")
  for (subset in res_els@subset_list) {
    both_present <- all(c("V1", "V2") %in% subset)
    expect_false(both_present,
      info = "V1 and V2 (r=1.0) should not appear in the same subset (ELS)")
  }

  # We should have multiple subsets (at least 2) since V1/V2 must be separated
  expect_gte(length(res_bk@subset_list), 2L)
  expect_gte(length(res_els@subset_list), 2L)
})

test_that("threshold boundary: r exactly equal to threshold is included (threshold is inclusive)", {
  # The backend compares |r| <= threshold (src/clique_core.cpp), and the
  # documented contract is "maximum allowed absolute correlation" -- i.e. a
  # pair at exactly the threshold is compatible, not excluded.
  cor_mat <- diag(3)
  cor_mat[1, 2] <- cor_mat[2, 1] <- 0.7  # Exactly at threshold
  cor_mat[1, 3] <- cor_mat[3, 1] <- 0.3  # Below threshold
  cor_mat[2, 3] <- cor_mat[3, 2] <- 0.3  # Below threshold
  colnames(cor_mat) <- c("A", "B", "C")
  rownames(cor_mat) <- colnames(cor_mat)

  res <- MatSelect(cor_mat, threshold = 0.7, method = "bron-kerbosch")

  # All three pairs are at or below the threshold, so {A,B,C} is a single
  # maximal clique: A and B (r = 0.7) DO co-occur.
  expect_equal(length(res@subset_list), 1L)
  expect_true(all(c("A", "B", "C") %in% res@subset_list[[1]]))

  # Tightening the threshold just below 0.7 makes A-B incompatible: they
  # must now be separated into different maximal subsets.
  res_strict <- MatSelect(cor_mat, threshold = 0.69, method = "bron-kerbosch")
  for (subset in res_strict@subset_list) {
    expect_false(all(c("A", "B") %in% subset),
      info = "A and B (r=0.7) should not co-occur once threshold < 0.7")
  }
})

# ===========================================================================
# Additional corrSelect edge cases
# ===========================================================================

test_that("corrSelect errors with invalid cor_method", {
  df <- data.frame(a = rnorm(10), b = rnorm(10))

  expect_error(
    corrSelect(df, threshold = 0.7, cor_method = "invalid_method"),
    regexp = "should be one of"
  )
})

test_that("corrSelect errors clearly when only one complete-case row remains after NA removal (#32)", {
  df <- data.frame(
    a = c(1, NA, NA, NA),
    b = c(2, NA, NA, NA),
    c = c(3, NA, NA, NA)
  )

  # Should warn about the dropped rows, then error with a clear message
  # instead of the opaque `sd()`-on-too-few-rows base-R error it used to
  # surface (see #32).
  expect_warning(
    expect_error(corrSelect(df, threshold = 0.7),
                 "Fewer than two complete-case rows"),
    "Removed"
  )
})

test_that("corrSelect errors clearly when every row is dropped for missing values (#32)", {
  df <- data.frame(x = rnorm(10), y = rep(NA_real_, 10), z = rnorm(10))

  expect_warning(
    expect_error(corrSelect(df, threshold = 0.7),
                 "Fewer than two complete-case rows"),
    "Removed"
  )
})

test_that("corrSelect errors clearly on a single-row data frame with no missing values (#64)", {
  # Distinct from #32 above: no NA-driven row drop at all, just a data frame
  # that starts with a single row.
  df <- data.frame(x = 1, y = 2, z = 3)
  expect_error(corrSelect(df, threshold = 0.7), "Fewer than two complete-case rows")
})

test_that("corrSelect handles use_pivot argument with bron-kerbosch", {
  df <- data.frame(a = rnorm(10), b = rnorm(10), c = rnorm(10))

  # With pivot
  res_pivot <- corrSelect(df, threshold = 0.8, method = "bron-kerbosch", use_pivot = TRUE)
  expect_true(inherits(res_pivot, "CorrCombo"))

  # Without pivot
  res_no_pivot <- corrSelect(df, threshold = 0.8, method = "bron-kerbosch", use_pivot = FALSE)
  expect_true(inherits(res_no_pivot, "CorrCombo"))

  # Results should be equivalent
  expect_equal(length(res_pivot@subset_list), length(res_no_pivot@subset_list))
})

test_that("corrSelect default method is bron-kerbosch without force_in", {
  df <- data.frame(a = rnorm(10), b = rnorm(10), c = rnorm(10))

  res <- corrSelect(df, threshold = 0.8)
  expect_equal(res@search_type, "bron-kerbosch")
})

test_that("corrSelect default method is els with force_in", {
  df <- data.frame(a = rnorm(10), b = rnorm(10), c = rnorm(10))

  res <- corrSelect(df, threshold = 0.9, force_in = "a")
  expect_equal(res@search_type, "els")
})

# ===========================================================================
# MatSelect validation tests
# ===========================================================================

test_that("MatSelect errors on non-matrix input", {
  expect_error(
    MatSelect(data.frame(a = 1:3, b = 1:3), threshold = 0.5),
    "must be a numeric matrix"
  )
})

test_that("MatSelect errors on non-square matrix", {
  mat <- matrix(1:6, nrow = 2, ncol = 3)

  expect_error(
    MatSelect(mat, threshold = 0.5),
    "must be square"
  )
})

test_that("MatSelect errors on matrix with NA", {
  mat <- diag(3)
  mat[1, 2] <- NA

  expect_error(
    MatSelect(mat, threshold = 0.5),
    "must not contain NA"
  )
})

test_that("MatSelect errors on non-unit diagonal", {

  mat <- diag(3)
  mat[1, 1] <- 0.5

  expect_error(
    MatSelect(mat, threshold = 0.5),
    "Diagonal entries.*must be 1"
  )
})

test_that("MatSelect errors on non-symmetric matrix", {
  mat <- diag(3)
  mat[1, 2] <- 0.5
  mat[2, 1] <- 0.3  # Asymmetric

  expect_error(
    MatSelect(mat, threshold = 0.5),
    "must be symmetric"
  )
})

test_that("MatSelect validates threshold range", {
  mat <- diag(3)

  expect_error(
    MatSelect(mat, threshold = 0),
    "must be in the range"
  )

  expect_error(
    MatSelect(mat, threshold = 1.5),
    "must be in the range"
  )

  expect_error(
    MatSelect(mat, threshold = NA),
    "must be a single numeric"
  )

  expect_error(
    MatSelect(mat, threshold = "0.5"),
    "must be a single numeric"
  )
})

test_that("MatSelect errors on invalid force_in indices", {
  mat <- diag(3)
  colnames(mat) <- c("A", "B", "C")

  expect_error(
    MatSelect(mat, threshold = 0.5, force_in = c(1, 5)),
    "valid 1-based column indices"
  )

  expect_error(
    MatSelect(mat, threshold = 0.5, force_in = c(0, 1)),
    "valid 1-based column indices"
  )
})

test_that("MatSelect errors on force_in names not in matrix", {
  mat <- diag(3)
  colnames(mat) <- c("A", "B", "C")

  expect_error(
    MatSelect(mat, threshold = 0.5, force_in = c("A", "Z")),
    "not found in matrix"
  )
})

test_that("MatSelect errors on character force_in without colnames", {
  mat <- diag(3)  # No column names

  expect_error(
    MatSelect(mat, threshold = 0.5, force_in = "A"),
    "no column names"
  )
})

test_that("MatSelect warns on highly correlated force_in variables", {
  mat <- diag(3)
  mat[1, 2] <- mat[2, 1] <- 0.9  # High correlation
  colnames(mat) <- c("A", "B", "C")

  expect_warning(
    MatSelect(mat, threshold = 0.5, force_in = c("A", "B")),
    "mutually correlated beyond the threshold"
  )
})

test_that("MatSelect generates default variable names", {
  mat <- diag(3)  # No names

  res <- MatSelect(mat, threshold = 0.5)

  # Should have default names like V1, V2, V3
  expect_equal(res@var_names, c("V1", "V2", "V3"))
})

test_that("MatSelect handles threshold = 1 (keep all pairs)", {
  mat <- matrix(0.8, nrow = 3, ncol = 3)
  diag(mat) <- 1
  colnames(mat) <- c("A", "B", "C")

  res <- MatSelect(mat, threshold = 1.0)

  # With threshold = 1, all variables should be in one subset
  expect_equal(length(res@subset_list), 1)
  expect_setequal(res@subset_list[[1]], c("A", "B", "C"))
})

# ===========================================================================
# Additional coverage tests for corrSelect.R
# ===========================================================================

test_that("corrSelect warns about constant columns", {
  set.seed(1001)
  df <- data.frame(
    x = rnorm(20),
    const = rep(5, 20),  # Constant column (sd = 0)
    y = rnorm(20)
  )

  expect_warning(
    res <- corrSelect(df, threshold = 0.8),
    "constant.*excluded"
  )

  # Result should exclude the constant column
  expect_true(inherits(res, "CorrCombo"))
  expect_false("const" %in% res@var_names)
})

test_that("corrSelect handles multiple constant columns", {
  set.seed(1002)
  df <- data.frame(
    x = rnorm(20),
    const1 = rep(1, 20),
    const2 = rep(2, 20),
    y = rnorm(20)
  )

  expect_warning(
    res <- corrSelect(df, threshold = 0.8),
    "constant.*excluded"
  )

  expect_true(inherits(res, "CorrCombo"))
})

test_that("corrSelect errors when all remaining columns are constant", {
  df <- data.frame(
    const1 = rep(1, 10),
    const2 = rep(2, 10),
    factor_col = factor(letters[1:10])
  )

  expect_warning(
    expect_error(
      corrSelect(df, threshold = 0.7),
      "Less than two numeric columns"
    ),
    "constant.*excluded"
  )
})

test_that("corrSelect errors on a correlation matrix with NA/infinite values (#82)", {
  # Two non-constant columns of extreme magnitude overflow stats::cor()'s
  # internal variance/covariance computation to NaN -- distinct from the
  # constant-column path above (sd != 0 here, so that guard never fires),
  # exercising corrSelect()'s own "contains NA or infinite values" guard.
  set.seed(2001)
  n <- 20
  df <- data.frame(
    x1 = rnorm(n) * 1e200,
    x2 = rnorm(n) * 1e200,
    x3 = rnorm(n)
  )

  expect_error(
    corrSelect(df, threshold = 0.7),
    "Correlation matrix contains NA or infinite values"
  )
})

test_that("corrSelect prints message about skipped non-numeric columns", {
  set.seed(1003)
  df <- data.frame(
    num1 = rnorm(10),
    num2 = rnorm(10),
    factor_col = factor(c("a", "b")[sample(1:2, 10, replace = TRUE)]),
    ordered_col = ordered(c("low", "med", "high")[sample(1:3, 10, replace = TRUE)]),
    char_col = letters[1:10]
  )

  expect_message(
    res <- corrSelect(df, threshold = 0.8),
    "excluded"
  )

  expect_true(inherits(res, "CorrCombo"))
})

test_that("corrSelect force_in errors when variable excluded from correlation", {
  set.seed(1004)
  df <- data.frame(
    num1 = rnorm(20),
    const = rep(5, 20),  # Will be excluded due to being constant
    num2 = rnorm(20)
  )

  # Try to force_in a constant column (which gets excluded)
  expect_warning(
    expect_error(
      corrSelect(df, threshold = 0.8, force_in = "const"),
      "excluded from correlation"
    ),
    "constant"
  )
})

test_that("corrSelect force_in with invalid index errors", {
  df <- data.frame(a = rnorm(10), b = rnorm(10))

  expect_error(
    corrSelect(df, threshold = 0.8, force_in = c(0, 1)),
    "whole numbers between 1 and ncol"
  )

  expect_error(
    corrSelect(df, threshold = 0.8, force_in = c(1, 10)),
    "whole numbers between 1 and ncol"
  )
})

test_that("corrSelect with threshold validation", {
  df <- data.frame(a = rnorm(10), b = rnorm(10))

  expect_error(
    corrSelect(df, threshold = "0.5"),
    "must be a single numeric value"
  )

  expect_error(
    corrSelect(df, threshold = c(0.5, 0.7)),
    "must be a single numeric value"
  )

  expect_error(
    corrSelect(df, threshold = NA_real_),
    "must be a single numeric value"
  )

  expect_error(
    corrSelect(df, threshold = 0),
    "must be in the range"
  )

  expect_error(
    corrSelect(df, threshold = 1.5),
    "must be in the range"
  )
})

test_that("corrSelect errors for bicor when WGCNA not installed", {
  skip_if(requireNamespace("WGCNA", quietly = TRUE))

  df <- data.frame(a = rnorm(10), b = rnorm(10))

  expect_error(
    corrSelect(df, threshold = 0.8, cor_method = "bicor"),
    "Install the 'WGCNA' package"
  )
})

test_that("corrSelect errors for distance when energy not installed", {
  skip_if(requireNamespace("energy", quietly = TRUE))

  df <- data.frame(a = rnorm(10), b = rnorm(10))

  expect_error(
    corrSelect(df, threshold = 0.8, cor_method = "distance"),
    "Install the 'energy' package"
  )
})

test_that("corrSelect errors for maximal when minerva not installed", {
  skip_if(requireNamespace("minerva", quietly = TRUE))

  df <- data.frame(a = rnorm(10), b = rnorm(10))

  expect_error(
    corrSelect(df, threshold = 0.8, cor_method = "maximal"),
    "Install the 'minerva' package"
  )
})

test_that("corrSelect method parameter validation", {
  df <- data.frame(a = rnorm(10), b = rnorm(10))

  expect_error(
    corrSelect(df, threshold = 0.8, method = "invalid"),
    "should be one of"
  )
})

test_that("corrSelect handles data.table input", {
  skip_if_not_installed("data.table")

  set.seed(1005)
  dt <- data.table::data.table(a = rnorm(10), b = rnorm(10), c = rnorm(10))

  res <- corrSelect(dt, threshold = 0.8)
  expect_true(inherits(res, "CorrCombo"))
})

# ===========================================================================
# Additional edge case tests for full coverage
# ===========================================================================

test_that("corrSelect handles logical column type message", {
  set.seed(4001)
  df <- data.frame(
    num1 = rnorm(20),
    num2 = rnorm(20),
    logical_col = sample(c(TRUE, FALSE), 20, replace = TRUE)
  )

  expect_message(
    res <- corrSelect(df, threshold = 0.8),
    "excluded"
  )

  expect_true(inherits(res, "CorrCombo"))
})

test_that("corrSelect handles Date column exclusion", {
  set.seed(4002)
  df <- data.frame(
    num1 = rnorm(20),
    num2 = rnorm(20),
    date_col = Sys.Date() + 1:20
  )

  expect_message(
    res <- corrSelect(df, threshold = 0.8),
    "excluded"
  )

  expect_true(inherits(res, "CorrCombo"))
})

test_that("corrSelect handles complex column type exclusion", {
  set.seed(4003)
  df <- data.frame(
    num1 = rnorm(15),
    num2 = rnorm(15)
  )
  df$complex_col <- complex(real = 1:15, imaginary = 1:15)

  expect_message(
    res <- corrSelect(df, threshold = 0.8),
    "excluded"
  )

  expect_true(inherits(res, "CorrCombo"))
})

test_that("corrSelect force_in with non-existent name after constant removal", {
  set.seed(4004)
  df <- data.frame(
    num1 = rnorm(20),
    const = rep(5, 20),  # Constant, will be removed
    num2 = rnorm(20)
  )

  expect_warning(
    expect_error(
      corrSelect(df, threshold = 0.8, force_in = "const"),
      "excluded from correlation"
    ),
    "constant"
  )
})

test_that("corrSelect auto-selects bron-kerbosch without force_in", {
  set.seed(4005)
  df <- data.frame(a = rnorm(15), b = rnorm(15), c = rnorm(15))

  res <- corrSelect(df, threshold = 0.8)

  expect_equal(res@search_type, "bron-kerbosch")
})

test_that("corrSelect auto-selects els with force_in", {
  set.seed(4006)
  df <- data.frame(a = rnorm(15), b = rnorm(15), c = rnorm(15))

  res <- corrSelect(df, threshold = 0.9, force_in = "a")

  expect_equal(res@search_type, "els")
})

test_that("corrSelect handles multiple excluded column types", {
  set.seed(4007)
  df <- data.frame(
    num1 = rnorm(15),
    num2 = rnorm(15),
    factor_col = factor(letters[1:15]),
    char_col = letters[1:15],
    logical_col = sample(c(TRUE, FALSE), 15, replace = TRUE),
    ordered_col = ordered(1:15)
  )

  expect_message(
    res <- corrSelect(df, threshold = 0.8),
    "excluded"
  )

  expect_true(inherits(res, "CorrCombo"))
})

test_that("corrSelect with spearman handles tied ranks", {
  set.seed(4008)
  # Data with many ties
  df <- data.frame(
    a = c(1, 1, 2, 2, 3, 3, 4, 4, 5, 5),
    b = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2),
    c = rnorm(10)
  )

  res <- corrSelect(df, threshold = 0.8, cor_method = "spearman")

  expect_true(inherits(res, "CorrCombo"))
})

test_that("corrSelect with kendall correlation", {
  set.seed(4009)
  df <- data.frame(
    a = rnorm(15),
    b = rnorm(15),
    c = rnorm(15)
  )

  res <- corrSelect(df, threshold = 0.8, cor_method = "kendall")

  expect_true(inherits(res, "CorrCombo"))
  expect_equal(res@cor_method, "kendall")
})

test_that("corrSelect records n_rows_used correctly", {
  set.seed(4010)
  df <- data.frame(
    a = c(rnorm(18), NA, NA),
    b = rnorm(20),
    c = rnorm(20)
  )

  expect_warning(
    res <- corrSelect(df, threshold = 0.8),
    "Removed"
  )

  expect_equal(res@n_rows_used, 18L)
})

test_that("corrSelect handles all-constant after NA removal", {
  set.seed(4011)
  df <- data.frame(
    a = c(5, 5, NA, NA, NA),
    b = c(5, 5, NA, NA, NA),
    c = c(1, 2, 3, 4, 5)
  )

  # After NA removal, a and b become constant
  expect_warning(
    expect_error(
      corrSelect(df, threshold = 0.7),
      "Less than two numeric"
    )
  )
})

# ===========================================================================
# Edge case tests to increase coverage
# ===========================================================================

test_that("corrSelect errors on empty numeric data", {
  set.seed(4101)
  df <- data.frame(
    char1 = letters[1:10],
    char2 = LETTERS[1:10]
  )

  expect_error(
    corrSelect(df, threshold = 0.8),
    "Less than two numeric"
  )
})


# ===========================================================================
# Tests for corrSelect with optional measures
# ===========================================================================

test_that("corrSelect with bicor works", {
  skip_if_not(requireNamespace("WGCNA", quietly = TRUE))

  set.seed(7001)
  n <- 50
  df <- data.frame(
    x = rnorm(n),
    y = rnorm(n),
    z = rnorm(n)
  )

  result <- corrSelect(df, threshold = 0.5, cor_method = "bicor")
  expect_true(inherits(result, "CorrCombo"))
})

test_that("corrSelect with distance correlation works", {
  skip_if_not(requireNamespace("energy", quietly = TRUE))

  set.seed(7002)
  n <- 30
  df <- data.frame(
    x = rnorm(n),
    y = rnorm(n),
    z = rnorm(n)
  )

  result <- corrSelect(df, threshold = 0.5, cor_method = "distance")
  expect_true(inherits(result, "CorrCombo"))
})

test_that("corrSelect with maximal works", {
  skip_if_not(requireNamespace("minerva", quietly = TRUE))

  set.seed(7003)
  n <- 30
  df <- data.frame(
    x = rnorm(n),
    y = rnorm(n),
    z = rnorm(n)
  )

  result <- corrSelect(df, threshold = 0.5, cor_method = "maximal")
  expect_true(inherits(result, "CorrCombo"))
})

test_that("corrSelect returns size-1 subsets when all variables are mutually correlated (#30)", {
  set.seed(7100)
  n <- 30
  x <- rnorm(n)
  df <- data.frame(
    A = x,
    B = x + rnorm(n, sd = 0.001),
    C = x + rnorm(n, sd = 0.001)
  )

  result <- corrSelect(df, threshold = 0.5)

  expect_equal(length(result@subset_list), 3)
  expect_setequal(vapply(result@subset_list, identity, character(1)), c("A", "B", "C"))
})

Try the corrselect package in your browser

Any scripts or data that you put into this service are public.

corrselect documentation built on July 19, 2026, 1:06 a.m.