tests/testthat/test-S3-methods.R

In topolow: Force-Directed Euclidean Embedding of Dissimilarity Data

# tests/testthat/test-s3-methods.R

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

# Helper function to create a test topolow object
create_test_topolow_object <- function() {
  test_mat <- matrix(c(0, 1, 2, 1, 0, 3, 2, 3, 0), 3, 3)
  rownames(test_mat) <- colnames(test_mat) <- paste0("Point", 1:3)

  euclidean_embedding(
    test_mat,
    ndim = 2,
    mapping_max_iter = 10,
    k0 = 1.0,
    cooling_rate = 0.01,
    c_repulsion = 0.01,
    verbose = FALSE
  )
}

test_that("print.topolow works correctly", {
  result <- create_test_topolow_object()

  expect_s3_class(result, "topolow")

  # Test that print method produces expected output
  expect_output(print(result), "topolow optimization result:")
  expect_output(print(result), "Dimensions:")
  expect_output(print(result), "Iterations:")
  expect_output(print(result), "MAE:")
  expect_output(print(result), "Convergence achieved:")
  expect_output(print(result), "Final convergence error:")

  # Test that print returns the object invisibly
  returned <- capture.output(returned_obj <- print(result))
  expect_identical(returned_obj, result)
})

test_that("summary.topolow works correctly", {
  result <- create_test_topolow_object()

  # Test summary method output
  expect_output(summary(result), "topolow optimization result:")
  expect_output(summary(result), "Parameters:")
  expect_output(summary(result), "k0:")
  expect_output(summary(result), "cooling_rate:")
  expect_output(summary(result), "c_repulsion:")
})

test_that("print.topolow_convergence works correctly", {
  # Create test convergence data
  test_data <- data.frame(
    param1 = rnorm(500, mean = 1, sd = 0.01),
    param2 = rnorm(500, mean = 2, sd = 0.01)
  )

  conv_result <- check_gaussian_convergence(test_data, window_size = 100, tolerance = 0.1)

  expect_s3_class(conv_result, "topolow_convergence")

  # Test print output
  expect_output(print(conv_result), "topolow Convergence Diagnostics")
  expect_output(print(conv_result), "Overall Convergence Achieved:")
  expect_output(print(conv_result), "Mean Vector Converged:")
  expect_output(print(conv_result), "Covariance Matrix Converged:")
  expect_output(print(conv_result), "Final Parameter Means:")
})

test_that("plot.topolow_convergence creates valid plots", {
  skip_if_not_installed("ggplot2")
  skip_if_not_installed("gridExtra")

  # Create test convergence data
  test_data <- data.frame(
    param1 = rnorm(200, mean = 1, sd = 0.1),
    param2 = rnorm(200, mean = 2, sd = 0.1)
  )

  conv_result <- check_gaussian_convergence(test_data, window_size = 50)

  # Test that plot method works
  expect_no_error(plot(conv_result))

  # Test with custom parameter names
  expect_no_error(plot(conv_result, param_names = c("Alpha", "Beta")))
})

test_that("topolow_diagnostics S3 methods work", {
  skip_if_not_installed("coda")

  # Create temporary chain files
  temp_dir <- tempdir()
  chain_files <- character(2)

  # Create sample chain data - ensure no missing values
  par_names <- c("log_N", "log_k0", "log_cooling_rate", "log_c_repulsion")
  set.seed(123)  # For reproducible data
  sample_data <- data.frame(
    log_N = rnorm(100, mean = 1, sd = 0.1),
    log_k0 = rnorm(100, mean = 0, sd = 0.1),
    log_cooling_rate = rnorm(100, mean = -3, sd = 0.1),
    log_c_repulsion = rnorm(100, mean = -2, sd = 0.1),
    NLL = runif(100, 50, 150),
    Holdout_MAE = runif(100, 0.5, 2.0)
  )

  for (i in 1:2) {
    chain_files[i] <- file.path(temp_dir, paste0("chain", i, ".csv"))
    write.csv(sample_data, chain_files[i], row.names = FALSE)
  }

  # Calculate diagnostics - suppress potential warnings about effective sample size
  suppressWarnings({
    diag_results <- calculate_diagnostics(chain_files, mutual_size = 50)
  })

  expect_s3_class(diag_results, "topolow_diagnostics")

  # Test print method
  expect_output(print(diag_results), "topolow Adaptive Sampling Diagnostics")
  expect_output(print(diag_results), "R-hat values")
  expect_output(print(diag_results), "Effective Sample Sizes")

  # Clean up
  unlink(chain_files)
})

test_that("profile_likelihood S3 methods work", {
  # Create test samples
  set.seed(123)  # For reproducible tests
  central_log_N <- 1.5
  test_samples <- data.frame(
    log_N = rnorm(100, mean = central_log_N, sd = 0.2),  # More concentrated
    log_k0 = rnorm(100, mean = 1.0, sd = 0.2),
    log_cooling_rate = rnorm(100, mean = -3.0, sd = 0.3),
    log_c_repulsion = rnorm(100, mean = -1.0, sd = 0.3),
    NLL = runif(100, 20, 100)
  )

  # Suppress expected warnings for small datasets
  suppressWarnings({
    pl_result <- profile_likelihood("log_N", test_samples,
                                    grid_size = 6,
                                    bandwidth_factor = 0.4,  # Larger bandwidth
                                    min_samples = 2)        # Fewer minimum samples
  })
  expect_s3_class(pl_result, "profile_likelihood")

  # Test print method
  expect_output(print(pl_result), "Profile Likelihood Analysis")
  expect_output(print(pl_result), "Parameter: log_N")
  expect_output(print(pl_result), "Grid Points Evaluated:")
  expect_output(print(pl_result), "Bandwidth Used:")
  expect_output(print(pl_result), "Sample Counts per Window")
})

test_that("plot.profile_likelihood creates valid plots", {
  skip_if_not_installed("ggplot2")

  # Create test samples
  set.seed(123)
  test_samples <- data.frame(
    log_N = rnorm(100, mean = 1.5, sd = 0.2),
    log_k0 = rnorm(100, mean = 1.0, sd = 0.2),
    log_cooling_rate = rnorm(100, mean = -3.0, sd = 0.3),
    log_c_repulsion = rnorm(100, mean = -1.0, sd = 0.3),
    NLL = runif(100, 20, 100)
  )

  suppressWarnings({
    pl_result <- profile_likelihood("log_N", test_samples,
                                    grid_size = 6,
                                    bandwidth_factor = 0.4,
                                    min_samples = 2)
  })
  LL_max <- max(-test_samples$NLL)

  # Test plot creation - suppress ggplot warnings about missing values
  suppressWarnings({
    p <- plot(pl_result, LL_max)
  })
  expect_s3_class(p, "ggplot")

  # Test plot with saving (to temporary file)
  temp_dir <- tempdir()
  suppressWarnings({
    expect_no_error(
      plot(pl_result, LL_max, save_plot = TRUE, output_dir = temp_dir)
    )
  })

  # Check that file was created
  expected_file <- file.path(temp_dir, "profile_likelihood_log_N.pdf")
  expect_true(file.exists(expected_file))
  unlink(expected_file)
})

test_that("parameter_sensitivity S3 methods work", {
  # Create test samples
  test_samples <- data.frame(
    log_N = log(runif(100, 2, 6)),
    log_k0 = log(runif(100, 1, 5)),
    Holdout_MAE = runif(100, 0.5, 3.0)
  )

  # Calculate parameter sensitivity
  sens_result <- parameter_sensitivity_analysis("log_N", test_samples, bins = 10)

  expect_s3_class(sens_result, "parameter_sensitivity")

  # Test print method
  expect_output(print(sens_result), "Parameter Sensitivity Analysis")
  expect_output(print(sens_result), "Parameter Analyzed: log_N")
  expect_output(print(sens_result), "Number of Bins:")
  expect_output(print(sens_result), "Minimum MAE Found:")
  expect_output(print(sens_result), "Performance Threshold")
  expect_output(print(sens_result), "Sample Counts per Bin")
})

test_that("plot.parameter_sensitivity creates valid plots", {
  skip_if_not_installed("ggplot2")

  # Create test samples
  test_samples <- data.frame(
    log_k0 = log(runif(80, 1, 5)),
    Holdout_MAE = runif(80, 0.5, 3.0)
  )

  sens_result <- parameter_sensitivity_analysis("log_k0", test_samples, bins = 8)

  # Test plot creation
  p <- plot(sens_result)
  expect_s3_class(p, "ggplot")

  # Test plot with custom y-limit factor
  p_custom <- plot(sens_result, y_limit_factor = 1.2)
  expect_s3_class(p_custom, "ggplot")

  # Test plot with saving
  temp_dir <- tempdir()
  expect_no_error(
    plot(sens_result, save_plot = TRUE, output_dir = temp_dir)
  )

  expected_file <- file.path(temp_dir, "parameter_sensitivity_log_k0.pdf")
  expect_true(file.exists(expected_file))
  unlink(expected_file)
})

test_that("S3 method error handling works", {
  # Test plot.profile_likelihood with missing output_dir
  set.seed(123)  # For reproducible tests
  central_log_N <- 1.5
  test_samples <- data.frame(
    log_N = rnorm(100, mean = central_log_N, sd = 0.3),  # More concentrated around mean
    log_k0 = rnorm(100, mean = 1.0, sd = 0.2),
    log_cooling_rate = rnorm(100, mean = -3.0, sd = 0.3),
    log_c_repulsion = rnorm(100, mean = -1.0, sd = 0.3),
    NLL = runif(100, 20, 100)
  )
  suppressWarnings({
  pl_result <- profile_likelihood("log_N", test_samples,
                                  grid_size = 5,
                                  bandwidth_factor = 0.7,  # Even larger bandwidth
                                  min_samples = 2)
  })
  LL_max <- max(-test_samples$NLL)

  expect_error(
    plot(pl_result, LL_max, save_plot = TRUE),
    "'output_dir' must be provided when save_plot is TRUE"
  )

  # Test plot.parameter_sensitivity with missing output_dir
  sens_result <- parameter_sensitivity_analysis("log_N", test_samples, bins = 5, mae_col = "NLL")

  expect_error(
    plot(sens_result, save_plot = TRUE),
    "'output_dir' must be provided when save_plot is TRUE"
  )
})