tests/testthat/test-scoring.R

In egeulgen/pathfindR: Enrichment Analysis Utilizing Active Subnetworks

## Tests for agglomerated term scoring functions - Jan 2024

test_that("`score_terms()` -- returns score matrix", {
    mockery::stub(score_terms, "graphics::plot", NULL)

    small_result <- example_pathfindR_output[1:3, ]
    expect_is(score_terms(enrichment_table = small_result, exp_mat = example_experiment_matrix,
        plot_hmap = FALSE), "matrix")
    expect_is(score_terms(enrichment_table = small_result, exp_mat = example_experiment_matrix,
        plot_hmap = TRUE), "matrix")
    expect_is(score_terms(enrichment_table = small_result, exp_mat = example_experiment_matrix,
        cases = colnames(example_experiment_matrix)[1:3], plot_hmap = TRUE), "matrix")
})

test_that("`score_terms()` -- matches gene symbols correctly", {
  toy_result <- data.frame(
    ID = c("gset1", "gset2"),
    Term_Description = c("gset1", "gset2"),
    Up_regulated = "",
    Down_regulated = c(
      paste(paste0("Gene_", c(1, 3, 5)), collapse = ", "),
      paste(paste0("Gene_", c(6, 8)), collapse = ", ")
    )
  )
  toy_result2 <- data.frame(
    ID = c("gset1", "gset2"),
    Term_Description = c("gset1", "gset2"),
    Up_regulated = "",
    Down_regulated = c(
      paste(paste0("Dummy_", c(1, 3, 5)), collapse = ", "),
      paste(paste0("Gene_", c(6, 8)), collapse = ", ")
    )
  )
  toy_exp_mat <- matrix(
    rnorm(40), nrow = 10, ncol = 4, dimnames = list(paste0("gene_", 1:10), paste0("subject_", 1:4))
  )
  expect_is(res_mat <- score_terms(enrichment_table = toy_result, exp_mat = toy_exp_mat,
                        plot_hmap = FALSE), "matrix")
  expect_equal(nrow(res_mat), 2)


  expect_is(res_mat <- score_terms(enrichment_table = toy_result2, exp_mat = toy_exp_mat,
                                   plot_hmap = FALSE), "matrix")
  expect_equal(nrow(res_mat), 1)
})

test_that("`score_terms()` -- argument checks work", {
    expect_error(score_terms(enrichment_table = example_pathfindR_output, exp_mat = example_experiment_matrix,
        use_description = "INVALID"), "`use_description` should either be TRUE or FALSE")

    expect_error(score_terms(enrichment_table = example_pathfindR_output, exp_mat = example_experiment_matrix,
        plot_hmap = "INVALID"), "`plot_hmap` should either be TRUE or FALSE")

    expect_error(score_terms(enrichment_table = list(), exp_mat = example_experiment_matrix),
        "`enrichment_table` should be a data frame of enrichment results")

    tmp <- example_pathfindR_output[, -c(1, 2)]
    nec_cols <- c("ID", "Up_regulated", "Down_regulated")
    expect_error(score_terms(enrichment_table = tmp, exp_mat = example_experiment_matrix),
        paste0("`enrichment_table` should contain all of ", paste(dQuote(nec_cols),
            collapse = ", ")))
    nec_cols <- c("Term_Description", "Up_regulated", "Down_regulated")
    expect_error(score_terms(enrichment_table = tmp, exp_mat = example_experiment_matrix,
        use_description = TRUE), paste0("`enrichment_table` should contain all of ",
        paste(dQuote(nec_cols), collapse = ", ")))

    expect_error(score_terms(enrichment_table = example_pathfindR_output, exp_mat = list()),
        "`exp_mat` should be a matrix")

    expect_error(score_terms(enrichment_table = example_pathfindR_output, exp_mat = example_experiment_matrix,
        cases = list()), "`cases` should be a vector")
    expect_error(score_terms(enrichment_table = example_pathfindR_output, exp_mat = example_experiment_matrix,
        cases = LETTERS), "Missing `cases` in `exp_mat`")
})

test_that("duplicated term descriptions test", {
    small_result <- example_pathfindR_output[1:2, ]
    small_result$Term_Description <- small_result$Term_Description[1]
    expect_is(score_terms(enrichment_table = small_result, exp_mat = example_experiment_matrix,
        use_description = TRUE, plot_hmap = FALSE), "matrix")
})

test_that("`plot_scores()` -- creates term score heatmap ggplot object with correct labels",
    {
        score_mat <- score_terms(example_pathfindR_output[1:3, ], example_experiment_matrix,
            plot_hmap = FALSE)

        # default
        g <- plot_scores(score_mat)
        expect_is(g, "ggplot")
        expect_identical(g$labels$fill, "Score")
        expect_identical(g$labels$x, "Sample")
        expect_identical(g$labels$y, "Term")

        # cases provided
        g <- plot_scores(score_mat, cases = colnames(score_mat)[1:3])
        expect_is(g, "ggplot")
        expect_identical(g$labels$fill, "Score")
        expect_identical(g$labels$x, "Sample")
        expect_identical(g$labels$y, "Term")

        # default - label_samples = FALSE
        g <- plot_scores(score_mat, label_samples = FALSE)
        expect_is(g, "ggplot")
        expect_identical(g$labels$fill, "Score")
        expect_identical(g$labels$x, "Sample")
        expect_identical(g$labels$y, "Term")

        # cases provided - label_samples = FALSE
        g <- plot_scores(score_mat, cases = colnames(score_mat)[1:3], label_samples = FALSE)
        expect_is(g, "ggplot")
        expect_identical(g$labels$fill, "Score")
        expect_identical(g$labels$x, "Sample")
        expect_identical(g$labels$y, "Term")
    })

test_that("`plot_scores()` -- argument checks work", {
    expect_error(plot_scores(score_matrix = c()), "`score_matrix` should be a matrix")
    expect_error(plot_scores(score_matrix = data.frame()), "`score_matrix` should be a matrix")
    expect_error(plot_scores(score_matrix = list()), "`score_matrix` should be a matrix")

    mat <- matrix(1, nrow = 3, ncol = 2, dimnames = list(paste0("T", 1:3), c("A",
        "B")))

    expect_error(plot_scores(score_matrix = mat, cases = list()), "`cases` should be a vector")
    expect_error(plot_scores(score_matrix = mat, cases = c("A", "B", "C")), "Missing `cases` in `score_matrix`")

    expect_error(plot_scores(score_matrix = mat, label_samples = "INVALID"), "`label_samples` should be TRUE or FALSE")

    expect_error(plot_scores(score_matrix = mat, case_title = 1), "`case_title` should be a single character value")
    expect_error(plot_scores(score_matrix = mat, case_title = rep("z", 3)), "`case_title` should be a single character value")

    expect_error(plot_scores(score_matrix = mat, control_title = 1), "`control_title` should be a single character value")
    expect_error(plot_scores(score_matrix = mat, control_title = rep("z", 3)), "`control_title` should be a single character value")

    expect_error(plot_scores(score_matrix = mat, low = ""))
    expect_error(plot_scores(score_matrix = mat, mid = ""))
    expect_error(plot_scores(score_matrix = mat, high = ""))
})