Clean up messages in tests

Author: csoneson

tests/testthat/test-TreeHeatmap.R

@@ -1,20 +1,25 @@
 test_that("TreeHeatmap works", {
     ## Get some data
     ## -------------------------------------------------------------------------
-    library(TreeSummarizedExperiment)
-    library(ggtree)
-    library(ggplot2)
-    library(scales)
+    suppressPackageStartupMessages({
+        library(TreeSummarizedExperiment)
+        library(ggtree)
+        library(ggplot2)
+        library(scales)
+        library(GenomeInfoDb)
+    })
 
     ## Load example data (tiny tree with corresponding count matrix)
     tse <- readRDS(system.file("extdata", "tinytree_counts.rds",
                                package = "treeclimbR"))
 
     ## Prepare the tree figure
-    tree_fig <- ggtree(rowTree(tse), branch.length = "none",
-                       layout = "rectangular", open.angle = 100) +
-        geom_hilight(node = 18, fill = "orange", alpha = 0.3) +
-        geom_hilight(node = 13, fill = "blue", alpha = 0.3)
+    suppressWarnings({
+        tree_fig <- ggtree(rowTree(tse), branch.length = "none",
+                           layout = "rectangular", open.angle = 100) +
+            geom_hilight(node = 18, fill = "orange", alpha = 0.3) +
+            geom_hilight(node = 13, fill = "blue", alpha = 0.3)
+    })
 
     ## Aggregate counts for each of the highlighted subtrees
     tseagg <- aggTSE(
@@ -202,19 +207,21 @@ test_that("TreeHeatmap works", {
     expect_s3_class(hm, "ggtree")
 
     ## Change colors
-    hm <- TreeHeatmap(tree = rowTree(tseagg), tree_fig = tree_fig,
-                      hm_data = SummarizedExperiment::assay(tseagg, "counts"),
-                      cluster_column = TRUE, column_split = col_split,
-                      column_anno = col_anno, column_anno_gap = 1,
-                      column_anno_color = c(A = "red", B = "blue"),
-                      show_colnames = TRUE, colnames_position = "bottom",
-                      colnames_angle = 90, colnames_size = 2,
-                      colnames_offset_y = -0.4,
-                      show_title = TRUE, title_offset_y = 2,
-                      title_color = "blue") +
-        scale_fill_gradientn(
-            colours = c("blue", "yellow", "red"),
-            values = scales::rescale(c(5, 8, 10)),
-            guide = "colorbar", limits = c(5, 10))
+    expect_message({
+        hm <- TreeHeatmap(tree = rowTree(tseagg), tree_fig = tree_fig,
+                          hm_data = SummarizedExperiment::assay(tseagg, "counts"),
+                          cluster_column = TRUE, column_split = col_split,
+                          column_anno = col_anno, column_anno_gap = 1,
+                          column_anno_color = c(A = "red", B = "blue"),
+                          show_colnames = TRUE, colnames_position = "bottom",
+                          colnames_angle = 90, colnames_size = 2,
+                          colnames_offset_y = -0.4,
+                          show_title = TRUE, title_offset_y = 2,
+                          title_color = "blue") +
+            scale_fill_gradientn(
+                colours = c("blue", "yellow", "red"),
+                values = scales::rescale(c(5, 8, 10)),
+                guide = "colorbar", limits = c(5, 10))
+    }, "already present")
     expect_s3_class(hm, "ggtree")
 })

tests/testthat/test-aggDS.R

@@ -1,6 +1,6 @@
 test_that("aggDS works", {
     ## Generate example data
-    library(ape)
+    suppressPackageStartupMessages(library(ape))
     tr <- rtree(3, tip.label = LETTERS[seq_len(3)])
     set.seed(1L)
     cc <- matrix(rpois(60, 10), nrow = 6)
@@ -204,12 +204,14 @@ test_that("aggDS works", {
 
     ## Test that aggregation works - mean
     ## -------------------------------------------------------------------------
-    expect_warning({
-        out <- aggDS(TSE = tse, assay = "counts", sample_id = "sid",
-                     group_id = "gid", cluster_id = "cid", FUN = mean,
-                     message = TRUE)},
-        "Multiple nodes are found to have the same label"
-    )
+    suppressMessages({
+        expect_warning({
+            out <- aggDS(TSE = tse, assay = "counts", sample_id = "sid",
+                         group_id = "gid", cluster_id = "cid", FUN = mean,
+                         message = TRUE)},
+            "Multiple nodes are found to have the same label"
+        )
+    })
     expect_s4_class(out, "SummarizedExperiment")
     expect_equal(nrow(out), nrow(tse))
     expect_equal(ncol(out), length(unique(tse$sid)))

tests/testthat/test-diffcyt_workflow.R

@@ -1,7 +1,7 @@
 test_that("diffcyt workflow works", {
     ## Generate some data and run through diffcyt workflow
     ## -------------------------------------------------------------------------
-    library(diffcyt)
+    suppressPackageStartupMessages(library(diffcyt))
     ## Helper function to create random data (one sample)
     d_random <- function(n = 20000, mean = 0, sd = 1, ncol = 20, cofactor = 5) {
         d <- sinh(matrix(rnorm(n, mean, sd), ncol = ncol)) * cofactor
@@ -26,7 +26,7 @@ test_that("diffcyt workflow works", {
     )
     d_se <- diffcyt::prepareData(d_input, experiment_info, marker_info)
     d_se <- diffcyt::transformData(d_se)
-    d_se <- diffcyt::generateClusters(d_se)
+    suppressMessages({d_se <- diffcyt::generateClusters(d_se)})
 
     ## buildTree - check that function errors if provided wrong input
     ## -------------------------------------------------------------------------
@@ -128,13 +128,15 @@ test_that("diffcyt workflow works", {
     }
 
     ## Run with message = TRUE
-    expect_warning({
+    suppressMessages({
         expect_warning({
             expect_warning({
-                out2 <- calcTreeMedians(d_se = d_se, tree = tr, message = TRUE)
+                expect_warning({
+                    out2 <- calcTreeMedians(d_se = d_se, tree = tr, message = TRUE)
+                }, "Multiple nodes are found to have the same label")
             }, "Multiple nodes are found to have the same label")
         }, "Multiple nodes are found to have the same label")
-    }, "Multiple nodes are found to have the same label")
+    })
     expect_identical(out, out2)
 
     ## With missing data (subset cells; some clusters will not have cells from

tests/testthat/test-evalCand.R

@@ -1,6 +1,6 @@
 test_that(".pseudoLeaf works", {
-    library(TreeSummarizedExperiment)
-    library(ggtree)
+    suppressPackageStartupMessages(library(TreeSummarizedExperiment))
+    suppressPackageStartupMessages(library(ggtree))
     data(tinyTree)
     set.seed(1)
     pv <- runif(19, 0, 1)
@@ -41,7 +41,7 @@ test_that(".pseudoLeaf works", {
 
 test_that("evalCand works", {
     ## Generate some data
-    library(TreeSummarizedExperiment)
+    suppressPackageStartupMessages(library(TreeSummarizedExperiment))
     data(tinyTree)
     set.seed(1)
     pv <- runif(19, 0, 1)
@@ -445,16 +445,18 @@ test_that("evalCand works", {
                  ignore_attr = TRUE)
 
     ## Multiple - use pseudo leaf
-    out <- evalCand(tree = tinyTree, type = "multiple",
-                    levels = list(gene1 = ll$candidate_list,
-                                  gene2 = llna$candidate_list),
-                    score_data = list(gene1 = ll$score_data,
-                                      gene2 = llna$score_data),
-                    node_column = "node", p_column = "pvalue",
-                    sign_column = "foldChange",
-                    feature_column = "feature", method = "BH",
-                    limit_rej = 0.05, use_pseudo_leaf = TRUE,
-                    message = TRUE)
+    suppressMessages({
+        out <- evalCand(tree = tinyTree, type = "multiple",
+                        levels = list(gene1 = ll$candidate_list,
+                                      gene2 = llna$candidate_list),
+                        score_data = list(gene1 = ll$score_data,
+                                          gene2 = llna$score_data),
+                        node_column = "node", p_column = "pvalue",
+                        sign_column = "foldChange",
+                        feature_column = "feature", method = "BH",
+                        limit_rej = 0.05, use_pseudo_leaf = TRUE,
+                        message = TRUE)
+    })
     expect_type(out, "list")
     expect_named(out, c("candidate_best", "output", "candidate_list",
                         "level_info", "FDR", "method", "column_info"))

tests/testthat/test-getCand.R

@@ -1,6 +1,6 @@
 test_that("getCand works", {
     ## Generate some data
-    library(TreeSummarizedExperiment)
+    suppressPackageStartupMessages(library(TreeSummarizedExperiment))
     data(tinyTree)
     set.seed(1)
     pv <- runif(19, 0, 1)
@@ -265,11 +265,13 @@ test_that("getCand works", {
     ## children have valid p-values.
     df2 <- df
     df2$pvalue[df2$node %in% c(1, 2, 4, 13)] <- NA
-    ll <- getCand(tree = tinyTree, score_data = df2,
-                  t = c(0.01, 0.05, 0.1, 0.25, 0.75),
-                  node_column = "node", p_column = "pvalue",
-                  sign_column = "foldChange", threshold = 0.05,
-                  pct_na = 0.75, message = TRUE)
+    suppressMessages({
+        ll <- getCand(tree = tinyTree, score_data = df2,
+                      t = c(0.01, 0.05, 0.1, 0.25, 0.75),
+                      node_column = "node", p_column = "pvalue",
+                      sign_column = "foldChange", threshold = 0.05,
+                      pct_na = 0.75, message = TRUE)
+    })
     expect_type(ll, "list")
     expect_named(ll, c("candidate_list", "score_data"))
     expect_type(ll$candidate_list, "list")

tests/testthat/test-getData.R

@@ -1,12 +1,14 @@
 test_that("getData works", {
     ## Generate some data
     ## -------------------------------------------------------------------------
-    library(TreeSummarizedExperiment)
-    library(ggtree)
-    library(ggplot2)
-    library(ggnewscale)
-    library(viridis)
-    library(dplyr)
+    suppressPackageStartupMessages({
+        library(TreeSummarizedExperiment)
+        library(ggtree)
+        library(ggplot2)
+        library(ggnewscale)
+        library(viridis)
+        library(dplyr)
+    })
 
     data(tinyTree)
 
@@ -28,10 +30,12 @@ test_that("getData works", {
     names(col_split) <- colnames(ct)
 
     ## Prepare the heatmaps
-    tree_fig <- ggtree(tinyTree, branch.length = "none",
-                       layout = "rectangular", open.angle = 100) +
-        geom_hilight(node = 18, fill = "orange", alpha = 0.3) +
-        geom_hilight(node = 13, fill = "blue", alpha = 0.3)
+    suppressWarnings({
+        tree_fig <- ggtree(tinyTree, branch.length = "none",
+                           layout = "rectangular", open.angle = 100) +
+            geom_hilight(node = 18, fill = "orange", alpha = 0.3) +
+            geom_hilight(node = 13, fill = "blue", alpha = 0.3)
+    })
     fig <- TreeHeatmap(
         tree = tinyTree, tree_fig = tree_fig, hm_data = ct,
         cluster_column = TRUE, column_split = col_split,
@@ -55,8 +59,10 @@ test_that("getData works", {
     )
 
     ## Figure with scaled tree
-    tree_fig_sc <- ggtree(tinyTree, branch.length = "none",
-           layout = "rectangular", open.angle = 100)
+    expect_warning({
+        tree_fig_sc <- ggtree(tinyTree, branch.length = "none",
+                              layout = "rectangular", open.angle = 100)
+    }, "must be used")
     tree_fig_sc <- ggtree::scaleClade(tree_fig_sc, node = 15, scale = 4)
     tree_fig_sc <- ggtree::scaleClade(tree_fig_sc, node = 14, scale = 0.25) +
         geom_hilight(node = 18, fill = "orange", alpha = 0.3) +

tests/testthat/test-getLevel.R

@@ -1,7 +1,7 @@
 test_that("getLevel works", {
     ## Generate some data
-    library(TreeSummarizedExperiment)
-    library(ggtree)
+    suppressPackageStartupMessages(library(TreeSummarizedExperiment))
+    suppressPackageStartupMessages(library(ggtree))
     data(tinyTree)
     set.seed(1)
     pv <- runif(19, min = 0.09, max = 0.11)
@@ -107,12 +107,14 @@ test_that("getLevel works", {
                           message = TRUE),
                  "The result will be output in the 'keep' column")
 
-    expect_error(getLevel(tree = tinyTree, score_data = out,
-                          drop = "pvalue > 0.05",
-                          score_column = "pvalue", node_column = "node",
-                          get_max = FALSE, parent_first = TRUE,
-                          message = TRUE),
-                 "'drop' must be or evaluate to logical")
+    expect_message(expect_message(
+        expect_error(getLevel(tree = tinyTree, score_data = out,
+                              drop = "pvalue > 0.05",
+                              score_column = "pvalue", node_column = "node",
+                              get_max = FALSE, parent_first = TRUE,
+                              message = TRUE),
+                     "'drop' must be or evaluate to logical"),
+        "Preparing"), "Dropping")
 
     ## Check that function works as expected for valid input
     ## -------------------------------------------------------------------------
@@ -186,21 +188,25 @@ test_that("getLevel works", {
     expect_equal(final$node[final$keep], c(1, 2, 3, 6, 7, 8, 9, 10, 18))
 
     ## Search for the highest value, don't filter, parent_first = FALSE
-    final <- getLevel(tree = tinyTree, score_data = out,
-                      drop =  pvalue > 1, score_column = "pvalue",
-                      node_column = "node", get_max = TRUE,
-                      parent_first = FALSE, message = TRUE)
+    suppressMessages({
+        final <- getLevel(tree = tinyTree, score_data = out,
+                          drop =  pvalue > 1, score_column = "pvalue",
+                          node_column = "node", get_max = TRUE,
+                          parent_first = FALSE, message = TRUE)
+    })
     expect_s3_class(final, "data.frame")
     expect_equal(nrow(final), nrow(out))
     expect_equal(final$node, out$node)
     expect_equal(final$pvalue, out$pvalue)
     expect_equal(final$node[final$keep], c(1, 2, 3, 6, 7, 8, 9, 10, 18))
 
     ## Search for the highest value, don't filter, parent_first = FALSE
-    final <- getLevel(tree = tinyTree, score_data = out,
-                      score_column = "pvalue",
-                      node_column = "node", get_max = TRUE,
-                      parent_first = FALSE, message = TRUE)
+    suppressMessages({
+        final <- getLevel(tree = tinyTree, score_data = out,
+                          score_column = "pvalue",
+                          node_column = "node", get_max = TRUE,
+                          parent_first = FALSE, message = TRUE)
+    })
     expect_s3_class(final, "data.frame")
     expect_equal(nrow(final), nrow(out))
     expect_equal(final$node, out$node)

tests/testthat/test-infoCand.R

@@ -1,5 +1,5 @@
 test_that("infoCand works", {
-    library(TreeSummarizedExperiment)
+    suppressPackageStartupMessages(library(TreeSummarizedExperiment))
     ## Generate example data
     data(tinyTree)
     set.seed(2L)

tests/testthat/test-medianByClusterMarker.R

@@ -1,6 +1,6 @@
 test_that("medianByClusterMarker works", {
     ## Generate some data
-    library(SummarizedExperiment)
+    suppressPackageStartupMessages(library(SummarizedExperiment))
     set.seed(1)
     count <- matrix(rpois(n = 1000, lambda = 10), nrow = 100)
     colnames(count) <- paste0("mk", 1:10)

tests/testthat/test-nodeResult.R

@@ -1,5 +1,6 @@
 test_that("nodeResult works", {
-    library(TreeSummarizedExperiment)
+    suppressPackageStartupMessages(library(TreeSummarizedExperiment))
+    suppressPackageStartupMessages(library(GenomeInfoDb))
     ## Generate some example data - DA
     da_lse <- readRDS(system.file("extdata", "da_sim_100_30_18de.rds",
                                   package = "treeclimbR"))
@@ -17,12 +18,14 @@ test_that("nodeResult works", {
         ds_se <- aggDS(TSE = ds_tse, assay = "counts", sample_id = "sample_id",
                        group_id = "group", cluster_id = "cluster_id", FUN = sum)
     })
-    ds_res <- runDS(SE = ds_se, tree = colTree(ds_tse), option = "glmQL",
-                    group_column = "group", contrast = c(0, 1),
-                    filter_min_count = 0, filter_min_total_count = 1,
-                    design = model.matrix(~ group, data = colData(ds_se)),
-                    filter_min_prop = 0, min_cells = 5, message = FALSE,
-                    legacy = FALSE)
+    suppressMessages(expect_message({
+        ds_res <- runDS(SE = ds_se, tree = colTree(ds_tse), option = "glmQL",
+                        group_column = "group", contrast = c(0, 1),
+                        filter_min_count = 0, filter_min_total_count = 1,
+                        design = model.matrix(~ group, data = colData(ds_se)),
+                        filter_min_prop = 0, min_cells = 5, message = TRUE,
+                        legacy = FALSE)
+    }, "0 nodes are ignored"))
 
     ## Check that function returns error with invalid input
     ## -------------------------------------------------------------------------