tests/testthat/test-theme.R

In tidyverse/ggplot2: Create Elegant Data Visualisations Using the Grammar of Graphics

skip_on_cran() # This test suite is long-running (on cran) and is skipped

test_that("dollar subsetting the theme does no partial matching", {
  t <- theme(foobar = 12)
  expect_null(t$foo)
  expect_equal(t$foobar, 12)
})

test_that("theme argument splicing works", {
  l <- list(a = 10, b = "c", d = c("foo", "bar"))
  test <- theme(!!!l)
  ref  <- theme(a = 10, b = "c", d = c("foo", "bar"))
  expect_equal(test, ref)
})

test_that("modifying theme element properties with + operator works", {

  # Changing a "leaf node" works
  t <- theme_grey() + theme(axis.title.x = element_text(colour = 'red', margin = margin()))
  expect_identical(t$axis.title.x, element_text(colour = 'red', margin = margin(), vjust = 1))
  # Make sure the theme class didn't change or get dropped
  expect_true(is.theme(t))
  # Make sure the element class didn't change or get dropped
  expect_true(inherits(t$axis.title.x, "element"))
  expect_true(inherits(t$axis.title.x, "element_text"))

  # Modifying an intermediate node works
  t <- theme_grey() + theme(axis.title = element_text(colour = 'red'))
  expect_identical(t$axis.title, element_text(colour = 'red'))

  # Modifying a root node changes only the specified properties
  t <- theme_grey() + theme(text = element_text(colour = 'red'))
  expect_identical(t$text$colour, 'red')
  expect_identical(t$text$family, theme_grey()$text$family)
  expect_identical(t$text$face,   theme_grey()$text$face)
  expect_identical(t$text$size,   theme_grey()$text$size)
  # Descendent is unchanged
  expect_identical(t$axis.title.x, theme_grey()$axis.title.x)

  # Adding element_blank replaces element
  t <- theme_grey() + theme(axis.text.y = element_blank())
  expect_identical(t$axis.text.y, element_blank())

  # Adding a non-blank element to an element_blank() replaces it
  t <- t + theme(axis.text.y = element_text(colour = 'red'))
  expect_identical(t$axis.text.y, element_text(colour = 'red'))

  # Adding empty theme() has no effect
  t <- theme_grey() + theme()
  expect_identical(t, theme_grey())

  expect_error(theme_grey() + "asdf")
})

test_that("adding theme object to ggplot object with + operator works", {
  ## test with complete theme
  p <- ggplot(data.frame(x = 1:3), aes(x, x)) + geom_point() + theme_grey()
  p <- p + theme(axis.title = element_text(size = 20))
  expect_true(p$theme$axis.title$size == 20)

  # Should update specified properties, but not reset other properties
  p <- p + theme(text = element_text(colour = 'red'))
  expect_true(p$theme$text$colour == 'red')
  tt <- theme_grey()$text
  tt$colour <- 'red'
  expect_true(tt$inherit.blank)
  tt$inherit.blank <- FALSE
  expect_identical(p$theme$text, tt)

  ## test without complete theme
  p <- ggplot(data.frame(x = 1:3), aes(x, x)) + geom_point()
  p <- p + theme(axis.title = element_text(size = 20))
  expect_true(p$theme$axis.title$size == 20)

  # Should update specified properties, but not reset other properties
  p <- p + theme(text = element_text(colour = 'red'))
  expect_true(p$theme$text$colour == 'red')
  expect_null(p$theme$text$family)
  expect_null(p$theme$text$face)
  expect_null(p$theme$text$size)
  expect_null(p$theme$text$hjust)
  expect_null(p$theme$text$vjust)
  expect_null(p$theme$text$angle)
  expect_null(p$theme$text$lineheight)
  expect_null(p$theme$text$margin)
  expect_null(p$theme$text$debug)

  ## stepwise addition of partial themes is identical to one-step addition
  p <- ggplot(data.frame(x = 1:3), aes(x, x)) + geom_point()
  p1 <- p + theme_light() +
    theme(axis.line.x = element_line(color = "blue")) +
    theme(axis.ticks.x = element_line(color = "red"))

  p2 <- p + theme_light() +
    theme(axis.line.x = element_line(color = "blue"),
          axis.ticks.x = element_line(color = "red"))

  expect_identical(p1$theme, p2$theme)
})

test_that("replacing theme elements with %+replace% operator works", {
  # Changing a "leaf node" works
  t <- theme_grey() %+replace% theme(axis.title.x = element_text(colour = 'red'))
  expect_identical(t$axis.title.x, element_text(colour = 'red'))
  # Make sure the class didn't change or get dropped
  expect_true(is.theme(t))

  # Changing an intermediate node works
  t <- theme_grey() %+replace% theme(axis.title = element_text(colour = 'red'))
  expect_identical(t$axis.title, element_text(colour = 'red'))
  # Descendent is unchanged
  expect_identical(t$axis.title.x, theme_grey()$axis.title.x)

  # Adding empty theme() has no effect
  t <- theme_grey() %+replace% theme()
  expect_identical(t, theme_grey())

  expect_error(theme_grey() + "asdf")
})

test_that("calculating theme element inheritance works", {
  t <- theme_grey() + theme(axis.title = element_text(colour = 'red'))

  # Check that properties are passed along from axis.title to axis.title.x
  e <- calc_element('axis.title.x', t)
  expect_identical(e$colour, 'red')
  expect_false(is.null(e$family))
  expect_false(is.null(e$face))
  expect_false(is.null(e$size))

  # Check that rel() works for relative sizing, and is applied at each level
  t <- theme_grey(base_size = 12) +
    theme(axis.title   = element_text(size = rel(0.5))) +
    theme(axis.title.x = element_text(size = rel(0.5)))
  e <- calc_element('axis.title', t)
  expect_identical(e$size, 6)
  ex <- calc_element('axis.title.x', t)
  expect_identical(ex$size, 3)

  # Check that a theme_blank in a parent node gets passed along to children
  t <- theme_grey() + theme(text = element_blank())
  expect_identical(calc_element('axis.title.x', t), element_blank())

  # Check that inheritance from derived class works
  element_dummyrect <- function(dummy) { # like element_rect but w/ dummy argument
    structure(list(
      fill = NULL, colour = NULL, dummy = dummy, linewidth = NULL,
      linetype = NULL, inherit.blank = FALSE
    ), class = c("element_dummyrect", "element_rect", "element"))
  }

  e <- calc_element(
    "panel.background",
    theme(
      rect = element_rect(fill = "white", colour = "black", linewidth = 0.5, linetype = 1),
      panel.background = element_dummyrect(dummy = 5),
      complete = TRUE # need to prevent pulling in default theme
    )
  )

  expect_identical(
    e,
    structure(list(
      fill = "white", colour = "black", dummy = 5, linewidth = 0.5, linetype = 1,
      inherit.blank = TRUE # this is true because we're requesting a complete theme
    ), class = c("element_dummyrect", "element_rect", "element"))
  )

  # Check that blank elements are skipped in inheritance tree if and only if elements
  # don't inherit from blank.
  t <- theme_gray() +
    theme(
      strip.text = element_blank(),
      strip.text.x = element_text() # inherit.blank = FALSE is default
    )
  e1 <- calc_element("strip.text.x", t)
  e2 <- calc_element("text", t)
  e2$inherit.blank <- FALSE # b/c inherit.blank = TRUE for complete themes
  expect_identical(e1, e2)

  theme <- theme_gray() +
    theme(strip.text = element_blank(), strip.text.x = element_text(inherit.blank = TRUE))
  e1 <- ggplot2:::calc_element("strip.text.x", theme)
  e2 <- ggplot2:::calc_element("strip.text", theme)
  expect_identical(e1, e2)

  # Check that rel units are computed appropriately
  theme <- theme_gray() +
    theme(axis.ticks.length = unit(1, "cm"),
          axis.ticks.length.x = rel(0.5),
          axis.ticks.length.x.bottom = rel(4))

  expect_equal(calc_element("axis.ticks.length.y.left", theme), unit(1, "cm"))
  expect_equal(calc_element("axis.ticks.length.x.top", theme), unit(1, "cm") * 0.5)
  expect_equal(calc_element("axis.ticks.length.x.bottom", theme), unit(1, "cm") * 0.5 * 4)
})

test_that("complete and non-complete themes interact correctly with each other", {
  # The 'complete' attribute of t1 + t2 is the OR of their 'complete' attributes.

  # But for _element properties_, the one on the right modifies the one on the left.
  t <- theme_bw() + theme(text = element_text(colour = 'red'))
  expect_true(attr(t, "complete"))
  expect_equal(t$text$colour, 'red')

  # A complete theme object (like theme_bw) always trumps a non-complete theme object
  t <- theme(text = element_text(colour = 'red')) + theme_bw()
  expect_true(attr(t, "complete"))
  expect_equal(t$text$colour, theme_bw()$text$colour)

  # Adding two non-complete themes: the one on the right modifies the one on the left.
  t <- theme(text = element_text(colour = 'blue')) +
    theme(text = element_text(colour = 'red'))
  expect_false(attr(t, "complete"))
  expect_equal(t$text$colour, 'red')
})

test_that("complete and non-complete themes interact correctly with ggplot objects", {
  base <- ggplot(data.frame(x = 1:3), aes(x, x)) + geom_point()

  # Check that adding two theme successive theme objects to a ggplot object
  # works like adding the two theme object to each other
  p <- ggplot_build(base + theme_bw() + theme(text = element_text(colour = 'red')))
  expect_true(attr(p$plot$theme, "complete"))

  # Compare the theme objects, after sorting the items, because item order can differ
  pt <- p$plot$theme
  tt <- theme_bw() + theme(text = element_text(colour = 'red'))
  pt <- pt[order(names(pt))]
  tt <- tt[order(names(tt))]
  expect_identical(pt, tt)

  p <- ggplot_build(base + theme(text = element_text(colour = 'red')) + theme_bw())
  expect_true(attr(p$plot$theme, "complete"))
  # Compare the theme objects, after sorting the items, because item order can differ
  pt <- p$plot$theme
  tt <- theme(text = element_text(colour = 'red')) + theme_bw()
  pt <- pt[order(names(pt))]
  tt <- tt[order(names(tt))]
  expect_identical(pt, tt)

  p <- ggplot_build(base + theme(text = element_text(colour = 'red', face = 'italic')))
  expect_false(attr(p$plot$theme, "complete"))
  expect_equal(p$plot$theme$text$colour, "red")
  expect_equal(p$plot$theme$text$face, "italic")

  p <- ggplot_build(base +
    theme(text = element_text(colour = 'red')) +
    theme(text = element_text(face = 'italic')))
  expect_false(attr(p$plot$theme, "complete"))
  expect_equal(p$plot$theme$text$colour, "red")
  expect_equal(p$plot$theme$text$face, "italic")
})

test_that("theme(validate=FALSE) means do not validate_element", {
  p <- ggplot(data.frame(x = 1:3), aes(x, x)) + geom_point()
  bw <- p + theme_bw()
  red.text <- theme(text = element_text(colour = "red"))
  bw.before <- bw + theme(animint.width = 500, validate = FALSE)
  expect_equal(bw.before$theme$animint.width, 500)

  bw.after <- p + theme(animint.width = 500, validate = FALSE) + theme_bw()
  expect_null(bw.after$theme$animint.width)

  red.after <- p + theme(animint.width = 500, validate = FALSE) + red.text
  expect_equal(red.after$theme$animint.width, 500)

  red.before <- p + red.text + theme(animint.width = 500, validate = FALSE)
  expect_equal(red.before$theme$animint.width, 500)
})

test_that("theme validation happens at build stage", {
  # adding a non-valid theme element to a theme is no problem
  expect_silent(theme_gray() + theme(text = 0))

  # the error occurs when we try to render the plot
  p <- ggplot() + theme(text = 0)
  expect_snapshot_error(print(p))

  # without validation, the error occurs when the element is accessed
  p <- ggplot() + theme(text = 0, validate = FALSE)
  expect_snapshot_error(print(p))
})

test_that("incorrect theme specifications throw meaningful errors", {
  expect_snapshot_error(add_theme(theme_grey(), theme(line = element_rect())))
  expect_snapshot_error(calc_element("line", theme(line = element_rect())))
  register_theme_elements(element_tree = list(test = el_def("element_rect")))
  expect_snapshot_error(calc_element("test", theme_gray() + theme(test = element_rect())))
  expect_snapshot_error(theme_set("foo"))
})

test_that("element tree can be modified", {
  # we cannot add a new theme element without modifying the element tree
  p <- ggplot() + theme(blablabla = element_text(colour = "red"))
  expect_snapshot_warning(print(p))

  register_theme_elements(
    element_tree = list(blablabla = el_def("character", "text"))
  )
  expect_snapshot_error(ggplotGrob(p))

  register_theme_elements(
    element_tree = list(blablabla = el_def("unit", "text"))
  )
  expect_snapshot_error(ggplotGrob(p))

  # things work once we add a new element to the element tree
  register_theme_elements(
    element_tree = list(blablabla = el_def("element_text", "text"))
  )
  expect_silent(ggplotGrob(p))

  p1 <- ggplot() + theme(blablabla = element_line())
  expect_snapshot_error(ggplotGrob(p1))

  # inheritance and final calculation of novel element works
  final_theme <- ggplot2:::plot_theme(p, theme_gray())
  e1 <- calc_element("blablabla", final_theme)
  e2 <- calc_element("text", final_theme)
  expect_identical(e1$family, e2$family)
  expect_identical(e1$face, e2$face)
  expect_identical(e1$size, e2$size)
  expect_identical(e1$lineheight, e2$lineheight)
  expect_identical(e1$colour, "red") # not inherited from element_text

  # existing elements can be overwritten
  ed <- el_def("element_rect", "rect")
  register_theme_elements(
    element_tree = list(axis.title = ed)
  )
  expect_identical(get_element_tree()$axis.title, ed)

  reset_theme_settings(reset_current = FALSE) # revert back to defaults
})

test_that("all elements in complete themes have inherit.blank=TRUE", {
  inherit_blanks <- function(theme) {
    all(vapply(theme, function(el) {
      if (inherits(el, "element") && !inherits(el, "element_blank")) {
        el$inherit.blank
      } else {
        TRUE
      }
    }, logical(1)))
  }
  expect_true(inherit_blanks(theme_grey()))
  expect_true(inherit_blanks(theme_bw()))
  expect_true(inherit_blanks(theme_classic()))
  expect_true(inherit_blanks(theme_dark()))
  expect_true(inherit_blanks(theme_light()))
  expect_true(inherit_blanks(theme_linedraw()))
  expect_true(inherit_blanks(theme_minimal()))
  expect_true(inherit_blanks(theme_void()))
})

test_that("elements can be merged", {
  text_base <- element_text(colour = "red", size = 10)
  expect_equal(
    merge_element(element_text(colour = "blue"), text_base),
    element_text(colour = "blue", size = 10)
  )
  rect_base <- element_rect(colour = "red", linewidth = 10)
  expect_equal(
    merge_element(element_rect(colour = "blue"), rect_base),
    element_rect(colour = "blue", linewidth = 10)
  )
  line_base <- element_line(colour = "red", linewidth = 10)
  expect_equal(
    merge_element(element_line(colour = "blue"), line_base),
    element_line(colour = "blue", linewidth = 10)
  )
  expect_error(
    merge_element(text_base, rect_base),
    "Only elements of the same class can be merged"
  )
})

test_that("theme elements that don't inherit from element can be combined", {
  expect_identical(combine_elements(1, NULL), 1)
  expect_identical(combine_elements(NULL, 1), 1)
  expect_identical(combine_elements(1, 0), 1)
})

test_that("complete plot themes shouldn't inherit from default", {
  default_theme <- theme_gray() + theme(axis.text.x = element_text(colour = "red"))
  base <- ggplot(data.frame(x = 1), aes(x, x)) + geom_point()

  ptheme <- plot_theme(base + theme(axis.text.x = element_text(colour = "blue")), default_theme)
  expect_equal(ptheme$axis.text.x$colour, "blue")

  ptheme <- plot_theme(base + theme_void(), default_theme)
  expect_null(ptheme$axis.text.x)
})

test_that("current theme can be updated with new elements", {
  old <- theme_set(theme_grey())

  b1 <- ggplot() + theme_grey()
  b2 <- ggplot()

  # works for root element
  expect_identical(
    calc_element("text", plot_theme(b1)),
    calc_element("text", plot_theme(b2))
  )

  # works for derived element
  expect_identical(
    calc_element("axis.text.x", plot_theme(b1)),
    calc_element("axis.text.x", plot_theme(b2))
  )

  # theme calculation for nonexisting element returns NULL
  expect_identical(calc_element("abcde", plot_theme(b1)), NULL)

  # element tree gets merged properly
  register_theme_elements(
    abcde = element_text(color = "blue", hjust = 0, vjust = 1),
    element_tree = list(abcde = el_def("element_text", "text"))
  )

  e1 <- calc_element("abcde", plot_theme(b2))
  e2 <- calc_element("text", plot_theme(b2))
  e2$colour <- "blue"
  e2$hjust <- 0
  e2$vjust <- 1
  expect_identical(e1, e2)

  reset_theme_settings()
  theme_set(old)
})

test_that("titleGrob() and margins() work correctly", {
  # ascenders and descenders
  g1 <- titleGrob("aaaa", 0, 0, 0.5, 0.5) # lower-case letters, no ascenders or descenders
  g2 <- titleGrob("bbbb", 0, 0, 0.5, 0.5) # lower-case letters, no descenders
  g3 <- titleGrob("gggg", 0, 0, 0.5, 0.5) # lower-case letters, no ascenders
  g4 <- titleGrob("AAAA", 0, 0, 0.5, 0.5) # upper-case letters, no descenders

  expect_equal(height_cm(g1), height_cm(g2))
  expect_equal(height_cm(g1), height_cm(g3))
  expect_equal(height_cm(g1), height_cm(g4))

  # margins
  g5 <- titleGrob("aaaa", 0, 0, 0.5, 0.5, margin = margin(t = 1, r = 0, b = 0, l = 0, unit = "cm"), margin_x = TRUE, margin_y = TRUE)
  g6 <- titleGrob("aaaa", 0, 0, 0.5, 0.5, margin = margin(t = 0, r = 1, b = 0, l = 0, unit = "cm"), margin_x = TRUE, margin_y = TRUE)
  g7 <- titleGrob("aaaa", 0, 0, 0.5, 0.5, margin = margin(t = 0, r = 0, b = 1, l = 0, unit = "cm"), margin_x = TRUE, margin_y = TRUE)
  g8 <- titleGrob("aaaa", 0, 0, 0.5, 0.5, margin = margin(t = 0, r = 0, b = 0, l = 1, unit = "cm"), margin_x = TRUE, margin_y = TRUE)

  expect_equal(height_cm(g5), height_cm(g1) + 1)
  expect_equal(width_cm(g5), width_cm(g1))
  expect_equal(height_cm(g6), height_cm(g1))
  expect_equal(width_cm(g6), width_cm(g1) + 1)
  expect_equal(height_cm(g7), height_cm(g1) + 1)
  expect_equal(width_cm(g7), width_cm(g1))
  expect_equal(height_cm(g8), height_cm(g1))
  expect_equal(width_cm(g8), width_cm(g1) + 1)

  # no margins when set to false
  g9 <- titleGrob("aaaa", 0, 0, 0.5, 0.5, margin = margin(t = 1, r = 1, b = 1, l = 1, unit = "cm"), margin_x = FALSE, margin_y = TRUE)
  g10 <- titleGrob("aaaa", 0, 0, 0.5, 0.5, margin = margin(t = 1, r = 1, b = 1, l = 1, unit = "cm"), margin_x = TRUE, margin_y = FALSE)
  expect_equal(height_cm(g9), height_cm(g1) + 2)
  # when one of margin_x or margin_y is set to FALSE and the other to TRUE, then the dimension for FALSE turns into
  # length 1null.
  expect_equal(g9$widths, grid::unit(1, "null"))
  expect_equal(g10$heights, grid::unit(1, "null"))
  expect_equal(width_cm(g10), width_cm(g1) + 2)
})

test_that("provided themes explicitly define all elements", {
  elements <- names(.element_tree)

  t <- theme_all_null()
  expect_true(all(names(t) %in% elements))
  expect_true(all(vapply(t, is.null, logical(1))))

  t <- theme_grey()
  expect_true(all(names(t) %in% elements))

  t <- theme_bw()
  expect_true(all(names(t) %in% elements))

  t <- theme_linedraw()
  expect_true(all(names(t) %in% elements))

  t <- theme_light()
  expect_true(all(names(t) %in% elements))

  t <- theme_dark()
  expect_true(all(names(t) %in% elements))

  t <- theme_minimal()
  expect_true(all(names(t) %in% elements))

  t <- theme_classic()
  expect_true(all(names(t) %in% elements))

  t <- theme_void()
  expect_true(all(names(t) %in% elements))

  t <- theme_test()
  expect_true(all(names(t) %in% elements))
})

test_that("Theme elements are checked during build", {
  p <- ggplot(mtcars) + geom_point(aes(disp, mpg)) + theme(plot.title.position = "test")
  expect_snapshot_error(ggplotGrob(p))

  p <- ggplot(mtcars) + geom_point(aes(disp, mpg)) + theme(plot.caption.position = "test")
  expect_snapshot_error(ggplotGrob(p))

  p <- ggplot(mtcars) + geom_point(aes(disp, mpg)) +
    theme(plot.tag.position = "test") + labs(tag = "test")
  expect_snapshot_error(ggplotGrob(p))
})

test_that("Theme validation behaves as expected", {
  tree <- get_element_tree()
  expect_silent(validate_element(1,  "aspect.ratio", tree))
  expect_silent(validate_element(1L, "aspect.ratio", tree))
  expect_snapshot_error(validate_element("A", "aspect.ratio", tree))
})

test_that("Element subclasses are inherited", {

  # `rich` is subclass of `poor`
  poor <- element_line(colour = "red", linetype = 3)
  rich <- element_line(linetype = 2, linewidth = 2)
  class(rich) <- c("element_rich", class(rich))

  # `poor` should acquire `rich`
  test <- combine_elements(poor, rich)
  expect_s3_class(test, "element_rich")
  expect_equal(
    test[c("colour", "linetype", "linewidth")],
    list(colour = "red", linetype = 3, linewidth = 2)
  )

  # `rich` should stay `rich`
  test <- combine_elements(rich, poor)
  expect_s3_class(test, "element_rich")
  expect_equal(
    test[c("colour", "linetype", "linewidth")],
    list(colour = "red", linetype = 2, linewidth = 2)
  )

  # `sibling` is not strict subclass of `rich`
  sibling <- poor
  class(sibling) <- c("element_sibling", class(sibling))

  # `sibling` should stay `sibling`
  test <- combine_elements(sibling, rich)
  expect_s3_class(test, "element_sibling")
  expect_equal(
    test[c("colour", "linetype", "linewidth")],
    list(colour = "red", linetype = 3, linewidth = 2)
  )

  # `rich` should stay `rich`
  test <- combine_elements(rich, sibling)
  expect_s3_class(test, "element_rich")
  expect_equal(
    test[c("colour", "linetype", "linewidth")],
    list(colour = "red", linetype = 2, linewidth = 2)
  )
})

test_that("Minor tick length supports biparental inheritance", {
  my_theme <- theme_gray() + theme(
    axis.ticks.length = unit(1, "cm"),
    axis.ticks.length.y.left = unit(1, "pt"),
    axis.minor.ticks.length.y = unit(1, "inch"),
    axis.minor.ticks.length = rel(0.5)
  )
  expect_equal( # Inherits rel(0.5) from minor, 1cm from major
    calc_element("axis.minor.ticks.length.x.bottom", my_theme),
    unit(1, "cm") * 0.5
  )
  expect_equal( # Inherits 1inch directly from minor
    calc_element("axis.minor.ticks.length.y.left", my_theme),
    unit(1, "inch")
  )
})

# Visual tests ------------------------------------------------------------

test_that("aspect ratio is honored", {
  df <- cbind(data_frame(x = 1:8, y = 1:8, f = gl(2,4)), expand.grid(f1 = 1:2, f2 = 1:2, rep = 1:2))
  p <- ggplot(df, aes(x, y)) +
    geom_point() +
    theme_test() +
    labs(x = NULL, y = NULL)

  p_a <- p + theme(aspect.ratio = 3)
  p_b <- p + theme(aspect.ratio = 1 / 3)

  expect_doppelganger("height is 3 times width",
    p_a
  )
  expect_doppelganger("width is 3 times height",
    p_b
  )

  expect_doppelganger("height is 3 times width, 2 wrap facets",
    p_a + facet_wrap(~f)
  )
  expect_doppelganger("height is 3 times width, 2 column facets",
    p_a + facet_grid(.~f)
  )
  expect_doppelganger("height is 3 times width, 2 row facets",
    p_a + facet_grid(f~.)
  )
  expect_doppelganger("height is 3 times width, 2x2 facets",
    p_a + facet_grid(f1~f2)
  )

})

test_that("themes don't change without acknowledgement", {
  df <- data_frame(x = 1:3, y = 1:3, z = c("a", "b", "a"), a = 1)
  plot <- ggplot(df, aes(x, y, colour = z)) +
    geom_point() +
    facet_wrap(~ a)

  expect_doppelganger("theme_bw", plot + theme_bw())
  expect_doppelganger("theme_classic", plot + theme_classic())
  expect_doppelganger("theme_dark", plot + theme_dark())
  expect_doppelganger("theme_minimal", plot + theme_minimal())
  expect_doppelganger("theme_gray", plot + theme_gray())
  expect_doppelganger("theme_light", plot + theme_light())
  expect_doppelganger("theme_void", plot + theme_void())
  expect_doppelganger("theme_linedraw", plot + theme_linedraw())
})

test_that("themes look decent at larger base sizes", {
  df <- data_frame(x = 1:3, y = 1:3, z = c("a", "b", "a"), a = 1)
  plot <- ggplot(df, aes(x, y, colour = z)) +
    geom_point() +
    facet_wrap(~ a)

  expect_doppelganger("theme_bw_large", plot + theme_bw(base_size = 33))
  expect_doppelganger("theme_classic_large", plot + theme_classic(base_size = 33))
  expect_doppelganger("theme_dark_large", plot + theme_dark(base_size = 33))
  expect_doppelganger("theme_minimal_large", plot + theme_minimal(base_size = 33))
  expect_doppelganger("theme_gray_large", plot + theme_gray(base_size = 33))
  expect_doppelganger("theme_light_large", plot + theme_light(base_size = 33))
  expect_doppelganger("theme_void_large", plot + theme_void(base_size = 33))
  expect_doppelganger("theme_linedraw_large", plot + theme_linedraw(base_size = 33))
})

test_that("axes can be styled independently", {
  plot <- ggplot() +
    geom_point(aes(1:10, 1:10)) +
    scale_x_continuous(sec.axis = dup_axis()) +
    scale_y_continuous(sec.axis = dup_axis()) +
    theme(
      axis.title.x.top = element_text(colour = 'red'),
      axis.title.x.bottom = element_text(colour = 'green'),
      axis.title.y.left = element_text(colour = 'blue'),
      axis.title.y.right = element_text(colour = 'yellow'),
      axis.text.x.top = element_text(colour = 'red'),
      axis.text.x.bottom = element_text(colour = 'green'),
      axis.text.y.left = element_text(colour = 'blue'),
      axis.text.y.right = element_text(colour = 'yellow'),
      axis.ticks.x.top = element_line(colour = 'red'),
      axis.ticks.x.bottom = element_line(colour = 'green'),
      axis.ticks.y.left = element_line(colour = 'blue'),
      axis.ticks.y.right = element_line(colour = 'yellow'),
      axis.line.x.top = element_line(colour = 'red'),
      axis.line.x.bottom = element_line(colour = 'green'),
      axis.line.y.left = element_line(colour = 'blue'),
      axis.line.y.right = element_line(colour = 'yellow')
    )
  expect_doppelganger("axes_styling", plot)
})

test_that("axes ticks can have independent lengths", {
  plot <- ggplot() +
    theme_test() +
    geom_point(aes(1:10, 1:10)) +
    scale_x_continuous(sec.axis = dup_axis()) +
    scale_y_continuous(sec.axis = dup_axis()) +
    theme(
      axis.ticks.length.x.top = unit(-.5, "cm"),
      axis.ticks.length.x.bottom = unit(-.25, "cm"),
      axis.ticks.length.y.left = unit(.25, "cm"),
      axis.ticks.length.y.right = unit(.5, "cm"),
      axis.text.x.bottom = element_text(margin = margin(t = .25, unit = "cm")),
      axis.text.x.top = element_text(margin = margin(b = .25, unit = "cm"))
    )
  expect_doppelganger("ticks_length", plot)
})

test_that("strips can be styled independently", {
  df <- data_frame(x = 1:2, y = 1:2)
  plot <- ggplot(df, aes(x, y)) +
    facet_grid(x ~ y) +
    theme(
      strip.background.x = element_rect(fill = "red"),
      strip.background.y = element_rect(fill = "green")
    )
  expect_doppelganger("strip_styling", plot)
})

test_that("rotated axis tick labels work", {
  df <- data_frame(
    y = c(1, 2, 3),
    label = c("short", "medium size", "very long label")
  )

  plot <- ggplot(df, aes(label, y)) + geom_point() +
    theme(axis.text.x = element_text(angle = 50, hjust = 1))
  expect_doppelganger("rotated x axis tick labels", plot)
})

test_that("plot titles and caption can be aligned to entire plot", {
  df <- data_frame(
    x = 1:3,
    y = 1:3,
    z = letters[1:3]
  )

  plot <- ggplot(df, aes(x, y, color = z)) +
    geom_point() + facet_wrap(~z) +
    labs(
      title = "Plot title aligned to entire plot",
      subtitle = "Subtitle aligned to entire plot",
      caption = "Caption aligned to panels"
    ) +
    theme(plot.title.position = "plot")
  expect_doppelganger("titles aligned to entire plot", plot)

  plot <- ggplot(df, aes(x, y, color = z)) +
    geom_point() + facet_wrap(~z) +
    labs(
      title = "Plot title aligned to panels",
      subtitle = "Subtitle aligned to panels",
      caption = "Caption aligned to entire plot"
    ) +
    theme(plot.caption.position = "plot")
  expect_doppelganger("caption aligned to entire plot", plot)

})

test_that("Legends can on all sides of the plot with custom justification", {

  plot <- ggplot(mtcars) +
    aes(
      disp, mpg,
      colour = hp,
      fill   = factor(gear),
      shape  = factor(cyl),
      size   = drat,
      alpha = wt
    ) +
    geom_point() +
    guides(
      shape  = guide_legend(position = "top"),
      colour = guide_colourbar(position = "bottom"),
      size   = guide_legend(position = "left"),
      alpha  = guide_legend(position = "right"),
      fill   = guide_legend(position = "inside", override.aes = list(shape = 21))
    ) +
    theme_test() +
    theme(
      legend.justification.top    = "left",
      legend.justification.bottom = c(1, 0),
      legend.justification.left   = c(0, 1),
      legend.justification.right  = "bottom",
      legend.justification.inside = c(0.75, 0.75),
      legend.location = "plot"
    )

  expect_doppelganger("legends at all sides with justification", plot)
})

test_that("Strips can render custom elements", {
  element_test <- function(...) {
    el <- element_text(...)
    class(el) <- c('element_test', 'element_text', 'element')
    el
  }
  element_grob.element_test <- function(element, label = "", x = NULL, y = NULL, ...) {
    rectGrob(width = unit(1, "cm"), height = unit(1, "cm"))
  }
  registerS3method("element_grob", "element_test", element_grob.element_test)

  df <- data_frame(x = 1:3, y = 1:3, a = letters[1:3])
  plot <- ggplot(df, aes(x, y)) +
    geom_point() +
    facet_wrap(~a) +
    theme(strip.text = element_test())
  expect_doppelganger("custom strip elements can render", plot)
})

test_that("legend margins are correct when using relative key sizes", {

  df <- data_frame(x = 1:3, y = 1:3, a = letters[1:3])
  p <- ggplot(df, aes(x, y, colour = x, shape = a)) +
    geom_point() +
    theme_test() +
    theme(
      legend.box.background = element_rect(colour = "blue", fill = NA),
      legend.background = element_rect(colour = "red", fill = NA)
    )

  vertical <- p + guides(
    colour = guide_colourbar(theme = theme(legend.key.height = unit(1, "null"))),
    shape  = guide_legend(theme = theme(legend.key.height = unit(1/3, "null")))
  ) + theme(
    legend.box.margin = margin(t = 5, b = 10, unit = "mm"),
    legend.margin = margin(t = 10, b = 5, unit = "mm")
  )

  expect_doppelganger("stretched vertical legends", vertical)

  horizontal <- p + guides(
    colour = guide_colourbar(theme = theme(legend.key.width = unit(1, "null"))),
    shape  = guide_legend(theme = theme(legend.key.width = unit(1/3, "null")))
  ) + theme(
    legend.position = "top",
    legend.box.margin = margin(l = 5, r = 10, unit = "mm"),
    legend.margin = margin(l = 10, r = 5, unit = "mm")
  )

  expect_doppelganger("stretched horizontal legends", horizontal)
})