tests/testthat/test-utils.R

In topolow: Force-Directed Euclidean Embedding of Dissimilarity Data

# tests/testthat/test-utils.R

# Copyright (c) 2025 Omid Arhami omid.arhami@uga.edu

test_that("extract_numeric_values handles mixed data correctly", {
  # Test with various threshold indicators
  mixed_data <- c(10, 20, "<5", ">100", 50, "25")
  result <- extract_numeric_values(mixed_data)

  expect_equal(result[1], 10)
  expect_equal(result[2], 20)
  expect_equal(result[3], 5)   # "<5" should become 5
  expect_equal(result[4], 100) # ">100" should become 100
  expect_equal(result[5], 50)
  expect_equal(result[6], 25)  # "25" should become 25
})

test_that("extract_numeric_values handles edge cases", {
  # Test with NA values
  data_with_na <- c(10, NA, "<5", ">100")
  result_na <- extract_numeric_values(data_with_na)
  expect_true(is.na(result_na[2]))
  expect_equal(result_na[3], 5)

  # Test with empty vector
  empty_result <- extract_numeric_values(c())
  expect_length(empty_result, 0)

  # Test with all numeric
  all_numeric <- c(1, 2, 3, 4, 5)
  result_numeric <- extract_numeric_values(all_numeric)
  expect_equal(result_numeric, all_numeric)

  # Test with all character (no threshold indicators)
  all_char <- c("10", "20", "30")
  result_char <- extract_numeric_values(all_char)
  expect_equal(result_char, c(10, 20, 30))

  # Test with invalid character values - suppress expected warnings
  invalid_char <- c("abc", "def", "10")
  suppressWarnings({
    result_invalid <- extract_numeric_values(invalid_char)
  })
  expect_true(is.na(result_invalid[1]))
  expect_true(is.na(result_invalid[2]))
  expect_equal(result_invalid[3], 10)
})

test_that("extract_numeric_values handles complex thresholds", {
  # Test with decimal thresholds
  decimal_thresholds <- c("<0.5", ">10.25", "5.75")
  result_decimal <- extract_numeric_values(decimal_thresholds)
  expect_equal(result_decimal[1], 0.5)
  expect_equal(result_decimal[2], 10.25)
  expect_equal(result_decimal[3], 5.75)

  # Test with scientific notation
  sci_notation <- c("<1e-3", ">1E5", "2.5e2")
  result_sci <- extract_numeric_values(sci_notation)
  expect_equal(result_sci[1], 0.001)
  expect_equal(result_sci[2], 100000)
  expect_equal(result_sci[3], 250)
})

test_that("create_cv_folds creates proper fold structure", {
  # Create test dissimilarity matrix
  test_mat <- matrix(runif(25, 1, 10), 5, 5)
  diag(test_mat) <- 0
  rownames(test_mat) <- colnames(test_mat) <- paste0("Point", 1:5)

  # Test basic fold creation
  folds <- create_cv_folds(test_mat, n_folds = 3, random_seed = 123)

  expect_length(folds, 3)
  expect_true(all(sapply(folds, is.list)))
  expect_true(all(sapply(folds, function(f) all(c("truth", "train") %in% names(f)))))

  # Check that each fold has the correct structure
  for (i in 1:3) {
    expect_true(is.matrix(folds[[i]]$truth))
    expect_true(is.matrix(folds[[i]]$train))
    expect_equal(dim(folds[[i]]$truth), dim(test_mat))
    expect_equal(dim(folds[[i]]$train), dim(test_mat))

    # Training matrix should have some NA values (holdout set)
    expect_true(sum(is.na(folds[[i]]$train)) > sum(is.na(test_mat)))
  }
})

test_that("create_cv_folds handles ground truth matrix", {
  # Create noisy input and clean ground truth
  input_mat <- matrix(runif(16, 1, 10), 4, 4)
  diag(input_mat) <- 0

  ground_truth_mat <- input_mat * 1.1  # Slightly different ground truth
  diag(ground_truth_mat) <- 0

  folds <- create_cv_folds(input_mat, ground_truth_mat, n_folds = 2, random_seed = 456)

  expect_length(folds, 2)

  # Truth should be the ground truth matrix, not the input
  for (i in 1:2) {
    expect_equal(folds[[i]]$truth, ground_truth_mat)
    # Training should be based on input matrix
    expect_true(sum(is.na(folds[[i]]$train)) > sum(is.na(input_mat)))
  }
})

test_that("create_cv_folds maintains matrix symmetry", {
  test_mat <- matrix(runif(16), 4, 4)
  test_mat[lower.tri(test_mat)] <- t(test_mat)[lower.tri(test_mat)]  # Make symmetric
  diag(test_mat) <- 0

  folds <- create_cv_folds(test_mat, n_folds = 2)

  for (i in 1:2) {
    train_mat <- folds[[i]]$train
    # Check that symmetry is maintained (if value is NA, its symmetric counterpart should also be NA)
    na_indices <- which(is.na(train_mat))
    for (idx in na_indices) {
      row <- (idx - 1) %/% nrow(train_mat) + 1
      col <- (idx - 1) %% ncol(train_mat) + 1
      if (row != col) {  # Skip diagonal
        expect_true(is.na(train_mat[col, row]))
      }
    }
  }
})

test_that("create_cv_folds input validation", {
  # Test with non-matrix input
  expect_error(create_cv_folds("not a matrix"),
               "`dissimilarity_matrix` must be a matrix")

  # Test with mismatched dimensions
  mat1 <- matrix(1:9, 3, 3)
  mat2 <- matrix(1:12, 3, 4)
  expect_error(create_cv_folds(mat1, mat2),
               "must have the same dimensions")

  # Test with invalid n_folds
  test_mat <- matrix(runif(9), 3, 3)
  expect_error(create_cv_folds(test_mat, n_folds = 1),
               "`n_folds` must be an integer greater than or equal to 2")
  expect_error(create_cv_folds(test_mat, n_folds = 5),
               "`n_folds` cannot be larger than the number of rows")

  # Test with invalid random seed
  expect_error(create_cv_folds(test_mat, random_seed = "abc"),
               "`random_seed` must be an integer")
})

test_that("create_cv_folds with reproducible results", {
  test_mat <- matrix(runif(25), 5, 5)
  diag(test_mat) <- 0

  # Test reproducibility with same seed
  folds1 <- create_cv_folds(test_mat, n_folds = 3, random_seed = 123)
  folds2 <- create_cv_folds(test_mat, n_folds = 3, random_seed = 123)

  # Should be identical
  expect_equal(folds1, folds2)

  # Test different results with different seeds
  folds3 <- create_cv_folds(test_mat, n_folds = 3, random_seed = 456)
  expect_false(identical(folds1, folds3))
})

test_that("ggsave_white_bg works as wrapper", {
  skip_if_not_installed("ggplot2")

  # Create a simple plot
  p <- ggplot2::ggplot() + ggplot2::geom_point(ggplot2::aes(x = 1, y = 1))
  temp_file <- tempfile(fileext = ".png")

  # Test that function works without error
  expect_no_error(
    ggsave_white_bg(temp_file, p, width = 2, height = 2, dpi = 72)
  )

  # Check that file was created
  expect_true(file.exists(temp_file))

  unlink(temp_file)
})

test_that("color palette c25 is properly defined", {
  expect_true(exists("c25"))
  expect_true(is.character(c25))
  expect_length(c25, 20)  # Based on the definition in utils.R
  expect_true(all(nchar(c25) > 0))  # All elements should be non-empty strings

  # Test that colors are valid (basic check)
  expect_true(all(c25 %in% colors() | grepl("^#", c25)))
})