tests/testthat/test-BuildHeatmap.R

In metadeconfoundR: Covariate-Sensitive Analysis of Cross-Sectional High-Dimensional Data

library(testthat)
library(metadeconfoundR)

test_that("Function `BuildHeatmap()` works correctly", {
  feature <- reduced_feature
  metaMat <- metaMatMetformin

  input <- read.table("2025_10_07_example_output.tsv", header = T, sep = "\t")
  input$feature <- as.factor(input$feature)
  input$metaVariable <- as.factor(input$metaVariable)
  # saveRDS(result, "tests/testthat/20241128_exampl_output_BuildHeatmap.rds")
  expected_output <- readRDS("20241128_exampl_output_BuildHeatmap.rds")
  result <- BuildHeatmap(input)
  expect_equal(result$data, expected_output$data)

  # "nice names" format checks
  expect_warning(
    BuildHeatmap(
      input,
      cuneiform = T,
      keepMeta = colnames(metaMat),
      keepFeature = colnames(input),
      metaVariableNames = as.data.frame(cbind(colnames(metaMat), paste0(colnames(metaMat), "_nice"))),
      featureNames = cbind(colnames(feature), paste0(colnames(feature), "_nice"))
    ),
    'class(featureNames) was coerced to "data.frame"',
    fixed = TRUE
  )
  expect_warning(
    BuildHeatmap(
      input,
      cuneiform = T,
      keepMeta = colnames(metaMat),
      keepFeature = colnames(input),
      metaVariableNames = cbind(colnames(metaMat), paste0(colnames(metaMat), "_nice")),
      featureNames = as.data.frame(cbind(colnames(feature), paste0(colnames(feature), "_nice")))
    ),
    'class(metaVariableNames) was coerced to "data.frame"',
    fixed = TRUE
  )
  expect_warning(
    BuildHeatmap(
      input,
      cuneiform = T,
      keepMeta = colnames(metaMat),
      keepFeature = colnames(input),
      metaVariableNames = as.data.frame(cbind(colnames(metaMat), paste0(colnames(metaMat), "_nice"))),
      featureNames = as.data.frame(cbind(colnames(feature), rep("niceNames", ncol(feature))))
    ),
    'non-unique human-readable feature names where made unique using base::make.unique',
    fixed = TRUE
  )
  expect_warning(
    BuildHeatmap(
      input,
      cuneiform = T,
      keepMeta = colnames(metaMat),
      keepFeature = colnames(input),
      metaVariableNames = as.data.frame(cbind(colnames(metaMat), rep("niceNames", ncol(metaMat)))),
      featureNames = as.data.frame(cbind(colnames(feature), paste0(colnames(feature), "_nice")))
    ),
    c('non-unique human-readable metaVariable names where made unique using base::make.unique'),
    fixed = TRUE
  )

  expect_error(
    BuildHeatmap(
      input,
      d_cutoff = 0.8
    ),
    'No associations pass current q_cutoff and/or d_cutoff filters!',
    fixed = TRUE
  )

  # test for weird settings, where only confounded signal remains in plot
  expect_error(
    BuildHeatmap(
      input[input$feature == "MS0006" & input$metaVariable != "Status", ],
      intermedData = F,
    ),
    "No unconfounded associations remain with the current cutoff values. Consider manually including categorical metaVariables into the Heatmap by listing them through the 'keepMeta' argument.",
    fixed = TRUE
  )
  expect_warning(
    BuildHeatmap(
      input[input$feature == "MS0006" & input$metaVariable != "Status", ],
      intermedData = T,
    ),
    "No unconfounded associations remain with the current cutoff values. ",
    fixed = TRUE
  )

  # test legend setup for plots without any confounded signal
  expect_no_error(
    BuildHeatmap(
      MetaDeconfound(feature,
                     metaMat[, c("Status"), drop = F],
                     logLevel = "ERROR"
                     )
      )
  )


  # only do intermediate output
  result_intermed <- BuildHeatmap(input, intermedData = T)
  # plot from intermediate output
  expect_warning(
    BuildHeatmap(
      result_intermed
      ),
    "treating input as 'intermedData = T' Buildheatmap output!!"
    )

  example_output_wide <- readRDS("2025_10_07_example_output_wide.rds")
  # plot from wide format data
  expect_no_error(
    BuildHeatmap(
      example_output_wide,
      d_range = "full"
    )
  )

  # wrong number of colors
  expect_error(
    BuildHeatmap(
      example_output_wide,
      d_col = c("red", "blue")
    ),
    "wrong number of colors in d_col!\nSupply colors for c(min, middle, max)!",
    fixed = TRUE
  )

  # wrong d_range
  expect_error(
    BuildHeatmap(
      example_output_wide,
      d_range = "partTime"
    ),
    'd_range must be either "fit" or "full"!',
    fixed = TRUE
  )

  # no trusted
  expect_error(
    BuildHeatmap(
      example_output_wide,
      trusted = c()
    ),
    '"trusted" must contain at least one trusted status label',
    fixed = TRUE
  )

})

test_that("Function `BuildHeatmap()` works correctly with partial Eff", {
  feature <- reduced_feature
  metaMat <- metaMatMetformin
  input <- readRDS("2024_10_10_example_output_partialRand.rds")

  expect_no_error(
    BuildHeatmap(
      input,
      plotPartial = "partial"
    )
  )

  expect_no_error(
    BuildHeatmap(
      input,
      plotPartial = "partialRel"
    )
  )

  expect_no_error(
    BuildHeatmap(
      input,
      plotPartial = "partialNorm"
    )
  )

})