tests/testthat/test_plots.R

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")
})
talgalili/heatmaply documentation built on Oct. 19, 2023, 7:30 p.m.