tests/testthat/test-ggplot-legend.R

expect_traces <- function(gg, n.traces, name){
  stopifnot(is.numeric(n.traces))
  L <- expect_doppelganger_built(gg, paste0("legend-", name))
  all.traces <- L$data
  no.data <- sapply(all.traces, function(tr) {
    is.null(tr[["x"]]) && is.null(tr[["y"]])
  })
  has.data <- all.traces[!no.data]
  expect_equivalent(length(has.data), n.traces)
  list(data = has.data, layout = L$layout)
}

p <- ggplot(mtcars, aes(x = mpg, y = wt, color = factor(vs), shape = factor(cyl))) + 
  geom_point()

test_that("Discrete colour and shape get merged into one legend", {
  info <- expect_doppelganger_built(p, "scatter_legend")
  expect_equivalent(length(info$data), 5)
  expect_true(info$layout$showlegend)
  # 5 legend entries
  expect_equivalent(sum(sapply(info$data, "[[", "showlegend")), 5)
  # verify entries are sorted correctly
  nms <- sapply(info$data, "[[", "name")
  d <- unique(mtcars[c("vs", "cyl")])
  d <- d[order(d$vs, d$cyl), ]
  expect_identical(
    nms, paste0("(", d$vs, ",", d$cyl, ")")
  )
  legend_title <- info$layout$legend$title$text
  expect_match(legend_title, "^factor\\(vs\\)")
  expect_match(legend_title, "factor\\(cyl\\)$")
})


test_that("legend vanishes when theme(legend.position = 'none'')", {
  info <- expect_traces(p + theme(legend.position = "none"), 5, "hide")
  expect_identical(info$layout$showlegend, FALSE)
})

test_that("aesthetics can be discarded from legend with guide(aes = 'none')", {
  df1 <- data.frame(
    Date = seq(as.Date("2021-01-01"), as.Date("2021-01-10"), "days"),
    Series = c(rep("SeriesA", 10), rep("SeriesB", 10)),
    Values = rnorm(n = 20),
    Mean = 0, V1 = 2, V2 = -2
  )
  
  p <- ggplot(df1, aes(x=Date, y=Values, color = Series, linetype = Series, shape = Series)) +
    geom_line(aes(x = Date, y = Mean, color = "Mean", linetype = "Mean")) +
    geom_line(aes(x = Date, y = V1, color = "QC", linetype = "QC")) +
    geom_line(aes(x = Date, y = V2, color = "QC", linetype = "QC")) +
    geom_line() + 
    geom_point() + 
    guides(shape = "none", linetype = "none")
  
  expect_doppelganger(p, "guide-aes-none")
})


p <- ggplot(mtcars, aes(x = mpg, y = wt, color = factor(vs))) + 
  geom_point()

# TODO: better support for scale_*_discrete()
#test_that("trace order respects scale_color_discrete()", {
#  g <- p + scale_color_discrete(breaks = c(1, 0))
#  info <- expect_traces(g, 2, "iris-default")
#  nms <- unlist(lapply(info$data, "[[", "name"))
#  expect_true(all(nms == c("factor(vs): 1", "factor(vs): 0")))
#})
#
#test_that("missing breaks translates to showlegend=FALSE", {
#  g <- p + scale_color_discrete(breaks = 1)
#  info <- expect_traces(two.legend.entries, 3, "iris-trace-showlegend-FALSE")
#  expect_equivalent(sum(sapply(info, "[[", "showlegend")), 1)
#})

# test of legend position
test_that("very long legend items", {
  long_items <- data.frame(
    cat1 = sample(x = LETTERS[1:10], 
                  size = 100, replace = TRUE),
    cat2 = sample(x = c("AAAAAAAAAAAAAAAAAAAAAAAAAAAAA",
                        "BBBBBBBBBBBBBBBBBBBBBBBBBBBBB",
                        "CCCCCCCCCCCCCCCCCCCCCCCCCCCCC"),
                  size = 100, replace = TRUE)
  )
  p_long_items <- ggplot(long_items, aes(cat1, fill = cat2)) + 
    geom_bar(position = "dodge")
  info <- expect_traces(p_long_items, 3, "very-long-legend-items")
})

penguins <- palmerpenguins::penguins
penguins$All <- "All species"
p <- qplot(data = penguins, x = bill_length_mm, y = bill_depth_mm, color = All)

test_that("legend is created with discrete mapping regardless of unique values", {
  info <- expect_traces(p, 1, "one-entry")
  expect_true(info$data[[1]]$showlegend)
  expect_true(info$layout$showlegend)
  expect_true(nzchar(info$layout$legend$title$text))
})

test_that("can hide legend", {
  info <- expect_traces(hide_legend(p), 1, "hide-legend")
  expect_false(info$layout$showlegend)
  expect_null(info$layout$annotations %||% NULL)
})


# test of legend position
test_that("many legend items", {
  p <- ggplot(midwest, aes(category, fill = category)) + geom_bar()
  info <- expect_traces(p, length(unique(midwest$category)), "many legend items")
})

Try the plotly package in your browser

Any scripts or data that you put into this service are public.

plotly documentation built on Nov. 10, 2022, 5:42 p.m.