###############################################################################
context("Tests for `setup_heatmap`")
###############################################################################
basic_hmd <- function(body_matrix) {
as_heatmap_data(list(body_matrix = body_matrix))
}
###############################################################################
test_that("`setup_heatmap` does not work for invalid input", {
expect_error(
setup_heatmap(),
info = "setup_heatmap without arguments should throw an error"
)
expect_error(
setup_heatmap(x = list(body_data = matrix(), 1:10, TRUE)),
info = "setup_heatmap should receive a list of data-frames"
)
expect_error(
setup_heatmap(x = list(a = data.frame())),
info = "`bodydata` should be present"
)
})
###############################################################################
test_that("`setup_heatmap` works for valid input", {
df1 <- data.frame(
feature_id = letters[1:3],
sample_id = rep(LETTERS[1:3], each = 3),
fitted_value = 1:9
)
m1 <- matrix(
1:9,
nrow = 3, ncol = 3,
dimnames = list(letters[1:3], LETTERS[1:3])
)
expect_equal(
setup_heatmap(list(body_data = df1)),
basic_hmd(m1),
info = "If only bodydata is provided, it's converted to a matrix"
)
})
###############################################################################
test_that("user can define row, column and value indexes in `setup_heatmap`", {
df1 <- data.frame(
ensembl_id = letters[1:3],
treatment_group = rep(LETTERS[1:3], each = 3),
normalised_expression = 1:9
)
m1 <- matrix(
1:9,
nrow = 3, ncol = 3,
dimnames = list(letters[1:3], LETTERS[1:3])
)
expect_equal(
object = setup_heatmap(
list(body_data = df1),
row_index = "ensembl_id",
column_index = "treatment_group",
value_index = "normalised_expression"
),
expected = basic_hmd(m1),
info = paste(
"[row|column|value]_index should be used to construct body_matrix from",
"body_df"
)
)
})
###############################################################################
test_that("only features common to the body and row-data are heatmapped", {
# row_data features and body_data features are identical and order-matched
body1 <- data.frame(
feature_id = letters[1:3],
sample_id = rep(LETTERS[1:3], each = 3),
fitted_value = 1:9
)
rows1 <- data.frame(
feature_id = letters[1:3],
annotation = c(TRUE, FALSE, TRUE)
)
body1_matrix <- matrix(
1:9,
nrow = 3, dimnames = list(letters[1:3], LETTERS[1:3])
)
obj1 <- setup_heatmap(list(body_data = body1, row_data = rows1))
expect_equal(
object = obj1,
expected = as_heatmap_data(
list(body_matrix = body1_matrix, row_data = rows1)
),
info = paste(
"body/row-data should be unfiltered if all features are in both",
"body and row-data"
)
)
# row_data features and body_data features are identical but disordered
body2 <- data.frame(
feature_id = letters[3:1],
sample_id = rep(LETTERS[1:3], each = 3),
fitted_value = 1:9
)
rows2 <- data.frame(
feature_id = c("b", "a", "c"),
annotation = c(TRUE, FALSE, TRUE)
)
body2_matrix <- matrix(
c(3, 2, 1, 6, 5, 4, 9, 8, 7),
nrow = 3, dimnames = list(letters[1:3], LETTERS[1:3])
)
obj2 <- setup_heatmap(list(body_data = body2, row_data = rows2))
expect_equal(
object = obj2,
expected = as_heatmap_data(
list(
body_matrix = body2_matrix,
row_data = rows2[order(rows2$feature_id), ]
)
),
info = paste(
"body/row-data should be unfiltered if all features are in both",
"body and row-data (regardless of their order in the input)",
"and the `feature_id`s should be in identical order."
)
)
# row_data features are a subset of body_data features - body_data should be
# filtered
rows3 <- data.frame(
feature_id = letters[1:2],
annotation = c(TRUE, FALSE)
)
body3_matrix <- matrix(
c(1:2, 4:5, 7:8),
nrow = 2, dimnames = list(letters[1:2], LETTERS[1:3])
)
obj3 <- setup_heatmap(list(body_data = body1, row_data = rows3))
expect_equal(
object = obj3,
expected = as_heatmap_data(
list(body_matrix = body3_matrix, row_data = rows3)
),
info = paste(
"row-data has a subset of the body-data features: so body-data should",
"be filtered down by `setup_heatmap`"
)
)
# row_data features are a superset of body_data features - row_data should be
# filtered
body4 <- data.frame(
feature_id = letters[2:3],
sample_id = rep(LETTERS[1:3], each = 2),
fitted_value = 1:6
)
body4_matrix <- matrix(
1:6,
nrow = 2, dimnames = list(letters[2:3], LETTERS[1:3])
)
obj4 <- setup_heatmap(list(body_data = body4, row_data = rows1))
expect_equal(
object = obj4,
expected = as_heatmap_data(
list(body_matrix = body4_matrix, row_data = rows1[-1, ])
),
info = paste(
"row-data has a superset of the body-data features: so row-data should",
"be filtered down by `setup_heatmap`"
)
)
})
###############################################################################
test_that("only samples common to the body and column-data are heatmapped", {
body1 <- data.frame(
feature_id = letters[1:3],
sample_id = rep(LETTERS[1:3], each = 3),
fitted_value = 1:9
)
columns1 <- data.frame(
sample_id = LETTERS[1:3],
some_annot = c(TRUE, TRUE, FALSE)
)
body1_matrix <- matrix(
1:9,
nrow = 3, dimnames = list(letters[1:3], LETTERS[1:3])
)
obj1 <- setup_heatmap(list(body_data = body1, column_data = columns1))
expect_equal(
object = obj1,
expected = as_heatmap_data(
list(body_matrix = body1_matrix, column_data = columns1)
),
info = paste(
"body/column-data should be unfiltered if all samples are in both",
"body and column-data"
)
)
# column-data samples are a subset of the body-data samples
columns2 <- data.frame(
sample_id = LETTERS[1:2],
some_annot = c(TRUE, TRUE)
)
body2_matrix <- matrix(
1:6,
nrow = 3, dimnames = list(letters[1:3], LETTERS[1:2])
)
obj2 <- setup_heatmap(list(body_data = body1, column_data = columns2))
expect_equal(
object = obj2,
expected = as_heatmap_data(
list(body_matrix = body2_matrix, column_data = columns2)
),
info = paste(
"column data contains a subset of the samples in body-data; hence body",
"data should be filtered"
)
)
# column-data samples are a superset of the body-data samples
columns3 <- data.frame(
sample_id = LETTERS[1:4],
some_annot = c(TRUE, TRUE, FALSE, FALSE)
)
body3_matrix <- matrix(
1:9,
nrow = 3, dimnames = list(letters[1:3], LETTERS[1:3])
)
obj3 <- setup_heatmap(list(body_data = body1, column_data = columns3))
expect_equal(
object = obj3,
expected = as_heatmap_data(
list(body_matrix = body3_matrix, column_data = columns3[1:3, ])
),
info = paste(
"column data contains a superset of the samples in body-data; hence",
"the column-data should be filtered down"
)
)
# column-data ordering should specify the order of the samples in the
# resulting heatmap
columns4 <- data.frame(
sample_id = c("A", "C", "B"),
same_annot = c(TRUE, FALSE, TRUE)
)
body4_matrix <- matrix(
c(1, 2, 3, 7, 8, 9, 4, 5, 6),
nrow = 3, dimnames = list(letters[1:3], c("A", "C", "B"))
)
obj4 <- setup_heatmap(list(body_data = body1, column_data = columns4))
expect_equal(
object = obj4,
expected = as_heatmap_data(
list(body_matrix = body4_matrix, column_data = columns4)
),
info = paste(
"when the user provides column-data, the sample ordering in that",
"data-frame should be respected"
)
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.