context("plots")
expect_ggplotly <- function(g) {
expect_is(g, "ggplot")
expect_error(ggplot_build(g), NA)
expect_error(ggplotly(g), NA)
}
iris_plot <- iris[, -5]
iris_category <- iris[, 5, drop = FALSE]
test_that("ggplot_heatmap works", {
g <- heatmaply:::ggplot_heatmap(as.matrix(iris_plot))
expect_ggplotly(g)
g <- heatmaply:::ggplot_heatmap(as.matrix(iris_plot), node_type = "scatter")
expect_ggplotly(g)
g <- heatmaply:::ggplot_heatmap(
as.matrix(iris_plot),
label_names = c("a", "b", "c")
)
expect_ggplotly(g)
expect_error(heatmaply:::ggplot_heatmap(
as.matrix(iris_plot),
label_names = c("a")
))
})
test_that("plotly_heatmap works", {
p <- heatmaply:::plotly_heatmap(as.matrix(iris_plot))
expect_is(p, "plotly")
})
test_that("plotly_dend works", {
hc <- hclust(dist(iris_plot))
p <- heatmaply:::plotly_dend(hc)
expect_is(p, "plotly")
})
test_that("ggplot_side_color_plot works", {
g <- heatmaply:::ggplot_side_color_plot(
iris_category,
type = "row"
)
expect_ggplotly(g)
g <- heatmaply:::ggplot_side_color_plot(
iris_category,
type = "column"
)
expect_ggplotly(g)
})
test_that("plotly_side_color_plot works", {
p <- heatmaply:::plotly_side_color_plot(
iris_category,
type = "row"
)
expect_is(p, "plotly")
expect_error(ggplotly(p), NA)
p <- heatmaply:::plotly_side_color_plot(
iris_category,
type = "column"
)
expect_is(p, "plotly")
expect_error(plotly_build(p), NA)
})
test_that("predict_colors works", {
expect_error(heatmaply:::predict_colors("#ffffff"))
p <- heatmaply:::plotly_heatmap(as.matrix(iris_plot))
g <- heatmaply:::ggplot_heatmap(as.matrix(iris_plot))
expect_ggplotly(g)
expect_error(heatmaply:::predict_colors(p, plot_method = "plotly"), NA)
expect_error(
heatmaply:::predict_colors(p, plot_method = "plotly"),
NA
)
expect_error(
heatmaply:::predict_colors(ggplotly(g), plot_method = "ggplot"),
NA
)
})
test_that("parse_plotly_color works", {
expect_equal(
heatmaply:::parse_plotly_color("rgb(1,1,1,0)"),
heatmaply:::parse_plotly_color("rgb(1,1,1)"),
"#010101"
)
expect_equal(
toupper(heatmaply:::parse_plotly_color("rgb(255,255,255)")),
"#FFFFFF"
)
expect_equal(
heatmaply:::parse_plotly_color("rgb(0,0,0)"),
"#000000"
)
})
test_that("k_colors works", {
expect_equal(heatmaply:::k_colors(1), "black")
expect_equal(heatmaply:::k_colors(5), colorspace::rainbow_hcl(5))
})
test_that("default colors works", {
for (i in 1:50) {
expect_equal(length(heatmaply:::default_side_colors(i)), i)
}
})
test_that("numeric cols on dendrograms", {
dend <- as.dendrogram(hclust(dist(mtcars)))
dend <- dendextend::set(dend, "branches_k_color", 1:32)
expect_silent(heatmaply:::plotly_dend(dend))
})
test_that("side colors fail when bad palette", {
expect_error(
heatmaply:::ggplot_side_color_plot(iris[, 5, drop = FALSE]),
NA
)
expect_error(
heatmaply:::ggplot_side_color_plot(
iris[, 5, drop = FALSE],
palette = setNames(
RColorBrewer::brewer.pal(3, "Set3"),
unique(iris[, 5])
)
),
NA
)
expect_error(
heatmaply:::ggplot_side_color_plot(
iris[, 5, drop = FALSE],
palette = c("Nope" = "Nope")
)
)
expect_error(
heatmaply:::plotly_side_color_plot(iris[, 5, drop = FALSE]),
NA
)
expect_error(
heatmaply:::plotly_side_color_plot(
iris[, 5, drop = FALSE],
palette = setNames(
RColorBrewer::brewer.pal(3, "Set3"),
unique(iris[, 5])
)
),
NA
)
expect_error(
heatmaply:::plotly_side_color_plot(
iris[, 5, drop = FALSE],
palette = c("Nope" = "Nope")
)
)
})
test_that("plotly dend uses colors", {
dend <- hclust(dist(mtcars))
dend <- dendextend::color_branches(dend, k = 2)
p <- heatmaply:::plotly_dend(dend)
expect_is(p, "plotly")
dend <- dendextend::color_branches(dend, k = 2, col = c(1, 2))
p <- heatmaply:::plotly_dend(dend)
expect_is(p, "plotly")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.