tests/testthat/test-plotly-symbol.R

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

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

test_that("Mapping a variable to symbol works", {
  d <- palmerpenguins::penguins %>% 
    filter(!is.na(bill_length_mm))
  p <- plot_ly(d, x = ~bill_length_mm, 
               y = ~bill_depth_mm, symbol = ~species)
  l <- expect_traces(p, 3, "scatterplot-symbol")
  markers <- lapply(l$data, "[[", "marker")
  syms <- unlist(lapply(markers, "[[", "symbol"))
  expect_identical(syms, c("circle", "triangle-up", "square"))
})

test_that("Can set the symbol range.", {
  d <- palmerpenguins::penguins %>% 
    filter(!is.na(bill_length_mm))
  p <- plot_ly(d, x = ~bill_length_mm, 
               y = ~bill_depth_mm, symbol = ~species, symbols = 1:3)
  l <- expect_traces(p, 3, "scatterplot-symbol2")
  markers <- lapply(l$data, "[[", "marker")
  syms <- unlist(lapply(markers, "[[", "symbol"))
  expect_identical(syms, plotly:::pch2symbol(1:3))
})


test_that("Setting a constant symbol works", {
  #keep only 6 observations (to avoid warning of max 6 symbol)
  p <- plot_ly(palmerpenguins::penguins[1:6], x = 1:6, y = 1:6, symbol = I(0:5))
  l <- expect_traces(p, 1, "pch")
  markers <- lapply(l$data, "[[", "marker")
  syms <- unlist(lapply(markers, "[[", "symbol"))
  expect_identical(syms, plotly:::pch2symbol(0:5))
})

test_that("Warn about invalid symbol codes", {
  p <- plot_ly(palmerpenguins::penguins, x = ~bill_length_mm, y = ~bill_depth_mm, symbol = I("DNE"))
  expect_warning(plotly_build(p), "DNE")
})

test_that("Formula resulting in logical vector works", {
  s <- c("triangle-up", "circle-open")
  p <- plot_ly(x = 1:10, y = 1:10, symbol = ~1:10 > 5, symbols = s)
  l <- expect_traces(p, 2, "logical")
  markers <- lapply(l$data, "[[", "marker")
  syms <- unlist(lapply(markers, "[[", "symbol"))
  expect_identical(syms, s)
})

test_that("Can specify a scale manually", {
  pal <- c("1" = "cross", "0" = "diamond")
  p <- plot_ly(mtcars, x = ~mpg, y = ~disp, symbol = ~factor(vs), symbols = pal)
  l <- expect_traces(p, 2, "symbol-manual")
  markers <- lapply(l$data, "[[", "marker")
  expected <- setNames(pal[sapply(l$data, "[[", "name")], NULL)
  expect_equivalent(expected, sapply(markers, "[[", "symbol"))
})

test_that("Trace ordering matches factor levels", {
  p <- plot_ly(mtcars, x = ~mpg, y = ~disp, symbol = ~factor(vs, levels = c(1, 0)))
  l <- expect_traces(p, 2, "ordering")
  expect_equivalent(sapply(l$data, "[[", "name"), c("1", "0"))
})

test_that("Trace ordering is alphabetical", {
  #keep only 6 categories (to avoid warning)
  mpg2 <- mpg %>% dplyr::filter(class %in% c("compact", "midsize", "suv", "2seater", "pickup", "subcompact"))
  
  lvls <- sort(unique(mpg2$class))
  p <- plot_ly(mpg2, x = ~cty, y = ~hwy, symbol = ~class)
  l <- expect_traces(p, length(lvls), "alphabetical")
  expect_equivalent(sapply(l$data, "[[", "name"), lvls)
})