tests/testthat/test-ellipseParam.R

In HotellingEllipse: Hotelling’s T-Squared Statistic and Ellipse

test_that("ellipseParam function works correctly", {
  data("specData", package = "HotellingEllipse")
  set.seed(123)
  pca_mod <- specData %>%
    select(where(is.numeric)) %>%
    FactoMineR::PCA(scale.unit = FALSE, graph = FALSE)

  test_data <- pca_mod$ind$coord %>% as.data.frame()

  # Test 1: Function runs without errors for valid input
  expect_no_error(ellipseParam(test_data))

  # Test 2: Function returns expected structure
  result <- ellipseParam(test_data)
  expect_type(result, "list")
  expect_named(result, c("Tsquare", "cutoff.99pct", "cutoff.95pct", "nb.comp", "Ellipse"))

  # Test 3: Error for missing input data
  expect_error(ellipseParam(), "Missing input data.")

  # Test 4: Error for invalid input data type
  s <- seq(1, 100)
  expect_error(ellipseParam(s), "The input data must be a matrix, data frame or tibble.")

  # Test 5: Function accepts data frame, tibble, and matrix
  expect_no_error(ellipseCoord(as.data.frame(test_data)))
  expect_no_error(ellipseCoord(tibble::as_tibble(test_data)))
  expect_no_error(ellipseCoord(as.matrix(test_data)))

  # Test 6: Error for invalid rel.tol
  expect_error(ellipseParam(test_data, rel.tol = -0.1), "'rel.tol' must be a non-negative numeric value.")

  # Test 7: Error for invalid abs.tol
  expect_error(ellipseParam(test_data, abs.tol = -0.1), "'abs.tol' must be a non-negative numeric value.")

  # Test 8: Error when abs.tol > rel.tol
  expect_error(ellipseParam(test_data, rel.tol = 0.001, abs.tol = 0.01), "'abs.tol' must be less than or equal to 'rel.tol'.")

  # Test 9: Error for invalid threshold
  expect_error(ellipseParam(test_data, threshold = 1.5), "Threshold must be a numeric value between 0 and 1.")
  expect_error(ellipseParam(test_data, threshold = 0), "Threshold must be a numeric value between 0 and 1.")

  # Test 10: Error for invalid k
  expect_error(ellipseParam(test_data, k = 1), "'k' must be an integer between 2 and the number of components in the data")
  expect_error(ellipseParam(test_data, k = 0), "'k' must be an integer between 2 and the number of components in the data")

  # Test 11: Error for invalid pcx
  expect_error(ellipseParam(test_data, pcx = 0), "'pcx' must be an integer between 1 and the number of components in the data")
  expect_error(ellipseParam(test_data, pcx = 200), "'pcx' must be an integer between 1 and the number of components in the data")

  # Test 12: Error for invalid pcy
  expect_error(ellipseParam(test_data, pcy = 0), "'pcy' must be an integer between 1 and the number of components in the data")
  expect_error(ellipseParam(test_data, pcy = 200), "'pcy' must be an integer between 1 and the number of components in the data")

  # Test 13: Error when pcx equals pcy
  expect_error(ellipseParam(test_data, pcx = 1, pcy = 1), "'pcx' and 'pcy' must be different integers.")

  # Test 14: Function works with valid threshold
  expect_no_error(ellipseParam(test_data, threshold = 0.95))

  # Test 15: Warning when threshold is too low
  expect_warning(ellipseParam(test_data, threshold = 0.1), "The specified threshold .* is lower than the variance explained by the first component")
})

test_that("process_fixed_comp function works correctly", {
  set.seed(123)
  test_data <- matrix(rnorm(300), ncol = 3)
  colnames(test_data) <- c("Comp1", "Comp2", "Comp3")

  comp_var <- apply(test_data, 2, stats::var)
  total_var <- sum(comp_var)
  relative_var <- comp_var / total_var
  nearzero_var <- relative_var < 0.001

  result <- process_fixed_comp(test_data, k = 2, pcx = 1, pcy = 2, nearzero_var, comp_var, relative_var, rel.tol = 0.001)

  expect_type(result, "list")
  expect_named(result, c("Tsquare", "cutoff.99pct", "cutoff.95pct", "nb.comp", "Ellipse"))
  expect_equal(result$nb.comp, 2)
  expect_s3_class(result$Ellipse, "tbl_df")
})

test_that("process_threshold function works correctly", {
  set.seed(123)
  test_data <- matrix(rnorm(300), ncol = 3)
  colnames(test_data) <- c("Comp1", "Comp2", "Comp3")

  relative_var <- apply(test_data, 2, stats::var) / sum(apply(test_data, 2, stats::var))
  nearzero_var <- relative_var < 0.001

  result <- process_threshold(test_data, threshold = 0.95, nearzero_var, relative_var)

  expect_type(result, "list")
  expect_named(result, c("Tsquare", "cutoff.99pct", "cutoff.95pct", "nb.comp"))
  expect_true(result$nb.comp >= 1 && result$nb.comp <= ncol(test_data))
})

test_that("compute_tsquared function works correctly", {
  set.seed(123)
  test_data <- matrix(rnorm(300), ncol = 3)
  result <- compute_tsquared(test_data, ncomp = 2)

  expect_type(result, "list")
  expect_named(result, c("Tsq", "Tsq_limit1", "Tsq_limit2"))
  expect_s3_class(result$Tsq, "tbl_df")
  expect_true(is.numeric(result$Tsq_limit1))
  expect_true(is.numeric(result$Tsq_limit2))
})