tests/testthat/test-plotly-color.R

In gvarunkumar/plotly: Create Interactive Web Graphics via 'plotly.js'

context("plotly-color")

expect_traces <- function(p, n.traces, name){
  stopifnot(is.numeric(n.traces))
  L <- save_outputs(p, paste0("plotly-", name))
  expect_equal(length(L$data), n.traces)
  L
}

test_that("plot_ly() handles a simple scatterplot", {
  p <- plot_ly(iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~Petal.Width)
})

test_that("Mapping a factor variable to color works", {
  p <- plot_ly(iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~Species)
  l <- expect_traces(p, 3, "scatterplot-color-factor")
  markers <- lapply(l$data, "[[", "marker")
  cols <- unlist(lapply(markers, "[[", "color"))
  expect_equal(length(cols), 3)
})

test_that("Custom RColorBrewer pallette works for factor variable", {
  cols <- RColorBrewer::brewer.pal(9, "Set1")
  # specifying a pallette set should "span the gamut" 
  p <- plot_ly(iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~Species, 
               colors = "Set1")
  l <- expect_traces(p, 3, "scatterplot-color-factor-custom")
  markers <- lapply(l$data, "[[", "marker")
  colz <- unlist(lapply(markers, "[[", "color"))
  expect_identical(sort(cols[c(1, 5, 9)]), sort(colz))
  # providing vector of RGB codes should also work
  p <- plot_ly(iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~Species, 
               colors = cols[1:3])
  l <- expect_traces(p, 3, "scatterplot-color-factor-custom2")
  markers <- lapply(l$data, "[[", "marker")
  colz <- unlist(lapply(markers, "[[", "color"))
  expect_identical(sort(cols[1:3]), sort(colz))
})

test_that("Passing hex codes to colors argument works", {
  colz <- c('#FE8268', '#81E8FE', '#FED681', '#81FED6', '#FE81A9')
  d <- data.frame(Category = LETTERS[1:5], Value = 1:5, stringsAsFactors = FALSE)
  p <- plot_ly(d, x = ~Category, y = ~Value, type = "bar", 
               color = ~Category, colors = colz)
  l <- expect_traces(p, 5, "bar-color-factor-custom")
  colz2 <- sapply(l$data, function(x) x[["marker"]][["color"]])
  expect_identical(sort(colz), sort(colz2))
})

test_that("Mapping a numeric variable to color works", {
  p <- plot_ly(iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~Petal.Width)
  # one trace is for the colorbar
  l <- expect_traces(p, 2, "scatterplot-color-numeric")
  idx <- vapply(l$data, is.colorbar, logical(1))
  markerScale <- l$data[[which(idx)]]$marker
  markerDat <- l$data[[which(!idx)]]$marker
  expect_identical(markerDat$color, iris$Petal.Width)
  expect_identical(markerScale$colorbar$title, "Petal.Width")
  expect_equal(min(iris$Petal.Width), markerScale$cmin)
  expect_equal(max(iris$Petal.Width), markerScale$cmax)
  expect_true(all(0 <= markerScale$colorscale[,1] & markerScale$colorscale[,1] <= 1))
})

test_that("Custom RColorBrewer pallette works for numeric variable", {
  p <- plot_ly(iris, x = ~Sepal.Length, y = ~Petal.Length, 
               color = ~Petal.Width, colors = "Greens")
  # one trace is for the colorbar
  l <- expect_traces(p, 2, "scatterplot-color-numeric-custom")
})

test_that("axis titles get attached to scene object for 3D plots", {
  p <- plot_ly(iris, x = ~Petal.Length, y = ~Petal.Width, z = ~Sepal.Width)
  l <- expect_traces(p, 1, "scatterplot-scatter3d-axes")
  expect_identical(l$data[[1]]$type, "scatter3d")
  scene <- l$layout$scene
  expect_identical(scene$xaxis$title, "Petal.Length")
  expect_identical(scene$yaxis$title, "Petal.Width")
  expect_identical(scene$zaxis$title, "Sepal.Width")
})