tests/testthat/test-helpers.R

In SerolyzeR: Reading, Quality Control and Preprocessing of MBA (Multiplex Bead Assay) Data

library(testthat)


expect_equal_paths <- function(path1, path2) {
  path1 <- fs::path_abs(path1)
  path2 <- fs::path_abs(path2)
  expect_equal(path1, path2)
}

test_that("Test verify numeric join", {
  expect_true(verify_numeric_join(1, 1))
  expect_true(verify_numeric_join(NA, 1))
  expect_true(verify_numeric_join(1, NA))
  expect_false(verify_numeric_join(1, 2))
})

test_that("Test verify character join", {
  expect_true(verify_character_join("a", "a"))
  expect_true(verify_character_join(NULL, "a"))
  expect_true(verify_character_join("a", NULL))
  expect_false(verify_character_join("a", "b"))
})

test_that("Test get join value", {
  expect_equal(get_join_value(1, 1), 1)
  expect_equal(get_join_value(NA, 2), 2)
  expect_equal(get_join_value("a", "b"), NULL)
})

test_that("Test remove empty lists", {
  expect_equal(remove_empty_lists(list(1, 2, list())), list(1, 2))
  expect_equal(remove_empty_lists(list(1, 2, list(1, 2))), list(1, 2, list(1, 2)))
})

test_that("Test is.str.number function", {
  expect_true(is.str.number("1"))
  expect_false(is.str.number("a"))
})

test_that("Test is.scalar", {
  expect_true(is.scalar(1))
  expect_true(is.scalar(NA))
  expect_false(is.scalar(NULL))
  expect_false(is.scalar(c(1, 2)))
})

test_that("Test verbose cat", {
  expect_output(verbose_cat("a", "b"), "ab")
  expect_null(verbose_cat("a", "b", verbose = FALSE))
})

test_that("Test clamp function", {
  expect_equal(clamp(c(1, 0, 2), lower = 1), c(1, 1, 2))
  expect_equal(clamp(c(1, -1, NA), lower = 0), c(1, 0, NA))
  expect_equal(clamp(c(1, 2.2, 3), upper = 2), c(1, 2, 2))
  expect_equal(clamp(c(2, 10, NA), upper = 2), c(2, 2, NA))
})

test_that("Test format dilution function standard case", {
  dilutions <- c("1/2", "1/3", "1/4")
  dilution_values <- c(0.5, 0.33, 0.25)
  sample_types <- c("STANDARD CURVE", "STANDARD CURVE", "STANDARD CURVE")

  expect_equal(format_dilutions(dilutions, dilution_values, sample_types), "1/2, 1/3, 1/4")
})

test_that("Test format dilution function with sample types", {
  dilutions <- c("1/2", "1/3", "1/4")
  dilution_values <- c(0.5, 0.33, 0.25)
  sample_types <- c("STANDARD CURVE", "STANDARD CURVE", "SAMPLE")

  expect_equal(format_dilutions(dilutions, dilution_values, sample_types), "1/2, 1/3")
})

test_that("Test format dilution function with multiple duplicates", {
  dilutions <- c("1/2", "1/3", "1/4", "1/4")
  dilution_values <- c(0.5, 0.33, 0.25, 0.25)
  sample_types <- c("STANDARD CURVE", "STANDARD CURVE", "STANDARD CURVE", "STANDARD CURVE")

  expect_equal(format_dilutions(dilutions, dilution_values, sample_types), "1/2, 1/3, 2x1/4")
})

test_that("Test format dilution function with shuffled dilutions", {
  dilutions <- c("1/4", "1/2", "1/3")
  dilution_values <- c(0.25, 0.5, 0.33)
  sample_types <- c("STANDARD CURVE", "STANDARD CURVE", "STANDARD CURVE")

  expect_equal(format_dilutions(dilutions, dilution_values, sample_types), "1/2, 1/3, 1/4")
})

test_that("Test format dilution function with dilutions equal null", {
  dilutions <- NULL
  dilution_values <- c(0.25, 0.5, 0.33)
  sample_types <- c("STANDARD CURVE", "STANDARD CURVE", "SAMPLE")

  expect_equal(format_dilutions(dilutions, dilution_values, sample_types), NULL)
})


test_that("Test is.decreasing function", {
  expect_true(is.decreasing(NULL))
  expect_true(is.decreasing(c()))
  expect_true(is.decreasing(c(2)))
  expect_true(is.decreasing(c(3, 2, 1)))
  expect_false(is.decreasing(c(1, 2, 3)))
  expect_false(is.decreasing(c(1, 2, 2)))
  expect_error(is.decreasing(c(1, 2, NA)))
  expect_error(is.decreasing("wrong"))
})

test_that("Test validate_filepath_and_output_dir function", {
  tmp_dir <- tempdir(check = TRUE)
  # base case
  expect_equal_paths(
    validate_filepath_and_output_dir("test", tmp_dir, "plate_name", "report", "html"),
    file.path(tmp_dir, "test.html")
  )

  # extension handling
  expect_equal_paths(
    validate_filepath_and_output_dir("test", tmp_dir, "plate_name", "report", "html.html"),
    file.path(tmp_dir, "test.html.html")
  )


  expect_equal_paths(
    validate_filepath_and_output_dir("test.html", tmp_dir, "plate_name", "report", "html"),
    file.path(tmp_dir, "test.html")
  )

  # trailing full stop in extension
  expect_error(validate_filepath_and_output_dir("test", tmp_dir, "plate_name", "report", ".html"))

  # default filename creation
  expect_equal_paths(
    validate_filepath_and_output_dir(NULL, tmp_dir, "plate_name", "report", "html"),
    file.path(tmp_dir, "plate_name_report.html")
  )


  # filename with no output_dir
  expect_warning(
    validate_filepath_and_output_dir(file.path(tmp_dir, "test.html"), tmp_dir, "plate_name", "report", "html")
  )

  expect_no_warning(
    validate_filepath_and_output_dir(file.path(tmp_dir, "test.html"), NULL, "plate_name", "report", "html")
  )

  file.create(file.path(tmp_dir, "test.html"))
  # overwrite existing file
  expect_warning(
    validate_filepath_and_output_dir(file.path(tmp_dir, "test.html"), tmp_dir, "plate_name", "report", "html")
  )

  # create output directory
  expect_no_error(
    validate_filepath_and_output_dir("test.html", file.path(tmp_dir, "output"), "plate_name", "report", "html")
  )

  expect_true(dir.exists(file.path(tmp_dir, "output")))
})

test_that("Test path checking", {
  plate1_filepath <- system.file("extdata", "CovidOISExPONTENT.csv", package = "SerolyzeR", mustWork = TRUE) # get the filepath of the csv dataset
  plate2_filepath <- system.file("extdata", "CovidOISExPONTENT_CO.csv", package = "SerolyzeR", mustWork = TRUE) # get the filepath of the csv dataset
  plate1_rel_filepath <- fs::path_rel(plate1_filepath, start = getwd())

  expect_true(check_path_equal(plate1_filepath, plate1_filepath))
  expect_true(check_path_equal(plate1_filepath, plate1_rel_filepath))
  expect_false(check_path_equal(plate1_filepath, plate2_filepath))
  expect_false(check_path_equal(plate1_filepath, NULL))
  expect_false(check_path_equal(plate1_filepath, "/tmp/non_existent.tsv"))
})

test_that("Test mba format function", {
  expect_true(is_mba_format(SerolyzeR.env$mba_formats[1]))
  expect_true(is_mba_format(NULL, allow_nullable = TRUE))
  expect_false(is_mba_format(NULL, allow_nullable = FALSE))
  expect_false(is_mba_format("invalid", allow_nullable = FALSE))
})

test_that("Test sorting a list", {
  l <- list(a = 2, b = 1)
  sl <- list(b = 1, a = 2)
  expect_equal(sort_list_by(l, decreasing = FALSE), sl)

  l <- list(a = list(v = 2), b = list(v = 1))
  sl <- list(b = list(v = 1), a = list(v = 2))
  expect_equal(sort_list_by(l, decreasing = FALSE, value_f = function(x) x$v), sl)
})

test_that("Test select columns function", {
  df <- data.frame(A = 1:3, B = 4:6)
  result <- select_columns(df, c("A", "B"))
  expect_equal(result, df)

  result <- select_columns(df, c("A", "B", "C"), replace_value = 0)
  expected <- data.frame(A = 1:3, B = 4:6, C = c(0, 0, 0))
  expect_equal(result, expected)
})

test_that("Test merging dataframes via handles intersection", {
  df1 <- data.frame(A = 1:3, B = 4:6)
  df2 <- data.frame(A = 3:5, B = 7:9)
  df3 <- data.frame(A = 7:9, C = 10:12)

  result1 <- merge_dataframes(list(df1), column_collision_strategy = "intersection")
  expected1 <- df1
  expect_equal(result1, expected1)

  result2 <- merge_dataframes(list(df1, df2), column_collision_strategy = "intersection")
  expected2 <- rbind(df1, df2)
  expect_equal(result2, expected2)

  result3 <- merge_dataframes(list(df1, df2, df3), column_collision_strategy = "intersection")
  expected3 <- data.frame(A = c(1:3, 3:5, 7:9))
  expect_equal(result3, expected3)
})

test_that("Test merging dataframes via handles union", {
  df1 <- data.frame(A = 1:3, B = 4:6)
  df2 <- data.frame(A = 3:5, B = 7:9)
  df3 <- data.frame(A = 7:9, C = 10:12)

  result1 <- merge_dataframes(list(df1), column_collision_strategy = "union")
  expected1 <- df1
  expect_equal(result1, expected1)

  result2 <- merge_dataframes(list(df1, df2), column_collision_strategy = "union", fill_value = NA)
  expected2 <- rbind(df1, df2)
  expect_equal(result2, expected2)

  result3 <- merge_dataframes(list(df1, df2, df3), column_collision_strategy = "union", fill_value = NA)
  expected3 <- data.frame(A = c(1:3, 3:5, 7:9), B = c(4:6, 7:9, rep(NA, 3)), C = c(rep(NA, 3), rep(NA, 3), 10:12))
  expect_equal(result3, expected3)
})