tests/testthat/test-facet-layout.R

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

a <- data_frame(a = c(1, 1, 2, 2), b = c(1, 2, 1, 1))
b <- data_frame(a = 3)
c <- data_frame(b = 3)
empty <- data_frame()

panel_layout <- function(facet, data) {
  layout <- create_layout(facet = facet, coord = CoordCartesian)
  layout$setup(data)
  layout$layout
}

test_that("grid: single row and single col are equivalent", {
  row <- panel_layout(facet_grid(a~.), list(a))
  col <- panel_layout(facet_grid(.~a), list(a))

  expect_equal(row$ROW, 1:2)
  expect_equal(row$ROW, col$COL)
  expect_equal(row[c("PANEL", "a")], col[c("PANEL", "a")])

  row <- panel_layout(facet_grid(a~.), list(a, b))
  col <- panel_layout(facet_grid(.~a), list(a, b))

  expect_equal(row$ROW, 1:3)
  expect_equal(row$ROW, col$COL)
  expect_equal(row[c("PANEL", "a")], col[c("PANEL", "a")])
})

test_that("grid: includes all combinations", {
  d <- data_frame(a = c(1, 2), b = c(2, 1))
  all <- panel_layout(facet_grid(a~b), list(d))

  expect_equal(nrow(all), 4)
})

test_that("wrap: layout sorting is correct", {

  dummy <- list(data_frame0(x = 1:5))

  test <- panel_layout(facet_wrap(~x, dir = "lt"), dummy)
  expect_equal(test$ROW, rep(c(1,2), c(3, 2)))
  expect_equal(test$COL, c(1:3, 1:2))

  test <- panel_layout(facet_wrap(~x, dir = "tl"), dummy)
  expect_equal(test$ROW, c(1, 2, 1, 2, 1))
  expect_equal(test$COL, c(1, 1, 2, 2, 3))

  test <- panel_layout(facet_wrap(~x, dir = "lb"), dummy)
  expect_equal(test$ROW, c(2, 2, 2, 1, 1))
  expect_equal(test$COL, c(1, 2, 3, 1, 2))

  test <- panel_layout(facet_wrap(~x, dir = "bl"), dummy)
  expect_equal(test$ROW, c(2, 1, 2, 1, 2))
  expect_equal(test$COL, c(1, 1, 2, 2, 3))

  test <- panel_layout(facet_wrap(~x, dir = "rt"), dummy)
  expect_equal(test$ROW, c(1, 1, 1, 2, 2))
  expect_equal(test$COL, c(3, 2, 1, 3, 2))

  test <- panel_layout(facet_wrap(~x, dir = "tr"), dummy)
  expect_equal(test$ROW, c(1, 2, 1, 2, 1))
  expect_equal(test$COL, c(3, 3, 2, 2, 1))

  test <- panel_layout(facet_wrap(~x, dir = "rb"), dummy)
  expect_equal(test$ROW, c(2, 2, 2, 1, 1))
  expect_equal(test$COL, c(3, 2, 1, 3, 2))

  test <- panel_layout(facet_wrap(~x, dir = "br"), dummy)
  expect_equal(test$ROW, c(2, 1, 2, 1, 2))
  expect_equal(test$COL, c(3, 3, 2, 2, 1))

})

test_that("wrap and grid are equivalent for 1d data", {
  rowg <- panel_layout(facet_grid(a~.), list(a))
  roww <- panel_layout(facet_wrap(~a, ncol = 1), list(a))
  expect_equal(roww, rowg)

  colg <- panel_layout(facet_grid(.~a), list(a))
  colw <- panel_layout(facet_wrap(~a, nrow = 1), list(a))
  expect_equal(colw, colg)
})

test_that("grid: crossed rows/cols create no more combinations than necessary", {
  facet <- facet_grid(a~b)

  one <- panel_layout(facet, list(a))
  expect_equal(nrow(one), 4)

  one_a <- panel_layout(facet, list(a, empty))
  expect_equal(nrow(one_a), 4)

  two <- panel_layout(facet, list(a, b))
  expect_equal(nrow(two), 4 + 2)

  three <- panel_layout(facet, list(a, b, c))
  expect_equal(nrow(three), 9)

  four <- panel_layout(facet, list(b, c))
  expect_equal(nrow(four), 1)
})

test_that("grid: nested rows/cols create no more combinations than necessary", {
  one <- panel_layout(facet_grid(drv+cyl~.), list(mpg))
  expect_equal(one$PANEL, factor(1:9))
  expect_equal(one$ROW, 1:9)
})

test_that("grid: margins add correct combinations", {
  one <- panel_layout(facet_grid(a~b, margins = TRUE), list(a))
  expect_equal(nrow(one), 4 + 2 + 2 + 1)
})

test_that("wrap: as.table reverses rows", {
  one <- panel_layout(facet_wrap(~a, ncol = 1, as.table = FALSE), list(a))
  expect_equal(one$ROW, c(2, 1))

  two <- panel_layout(facet_wrap(~a, nrow = 1, as.table = FALSE), list(a))
  expect_equal(two$ROW, c(1, 1))
})

test_that("wrap: as.table = FALSE gets axes", {
  p <- ggplot(mpg, aes(displ, hwy)) +
    geom_point() +
    scale_y_continuous(position = "left") +
    facet_wrap(vars(class), dir = "v", as.table = FALSE)
  expect_doppelganger("Axes are positioned correctly in non-table layout", p)
})

test_that("grid: as.table reverses rows", {
  one <- panel_layout(facet_grid(a~., as.table = FALSE), list(a))
  expect_equal(as.character(one$a), c("2", "1"))

  two <- panel_layout(facet_grid(a~., as.table = TRUE), list(a))
  expect_equal(as.character(two$a), c("1", "2"))
})

# Drop behaviour -------------------------------------------------------------

a2 <- data_frame(
  a = factor(1:3, levels = 1:4),
  b = factor(1:3, levels = 4:1),
  c = as.character(c(1:2, NA))
)

test_that("wrap: drop = FALSE preserves unused levels", {
  wrap_a <- panel_layout(facet_wrap(~a, drop = FALSE), list(a2))
  expect_equal(nrow(wrap_a), 4)
  expect_equal(as.character(wrap_a$a), as.character(1:4))

  wrap_b <- panel_layout(facet_wrap(~b, drop = FALSE), list(a2))
  expect_equal(nrow(wrap_b), 4)
  expect_equal(as.character(wrap_b$b), as.character(4:1))

  # NA character should not be dropped or throw errors #5485
  wrap_c <- panel_layout(facet_wrap(~c, drop = FALSE), list(a2))
  expect_equal(nrow(wrap_c), 3)
  expect_equal(wrap_c$c, a2$c)
})

test_that("grid: drop = FALSE preserves unused levels", {
  grid_a <- panel_layout(facet_grid(a~., drop = FALSE), list(a2))
  expect_equal(nrow(grid_a), 4)
  expect_equal(as.character(grid_a$a), as.character(1:4))

  grid_b <- panel_layout(facet_grid(b~., drop = FALSE), list(a2))
  expect_equal(nrow(grid_b), 4)
  expect_equal(as.character(grid_b$b), as.character(4:1))

  grid_ab <- panel_layout(facet_grid(a~b, drop = FALSE), list(a2))
  expect_equal(nrow(grid_ab), 16)
  expect_equal(as.character(grid_ab$a), as.character(rep(1:4, each = 4)))
  expect_equal(as.character(grid_ab$b), as.character(rep(4:1, 4)))
})

test_that("wrap: space = 'free_x/y' sets panel sizes", {

  df <- data.frame(x = 1:3)
  p <- ggplot(df, aes(x, x)) +
    geom_point() +
    scale_x_continuous(limits = c(0, NA), expand = c(0, 0)) +
    scale_y_continuous(limits = c(0, NA), expand = c(0, 0))

  # Test free_x
  gt <- ggplotGrob(p + facet_wrap(~x, scales = "free_x", space = "free_x"))
  test <- gt$widths[panel_cols(gt)$l]
  expect_equal(as.numeric(test), 1:3)

  # Test free_y
  gt <- ggplotGrob(p + facet_wrap(~x, scales = "free_y", space = "free_y"))
  test <- gt$heights[panel_rows(gt)$t]
  expect_equal(as.numeric(test), 1:3)
})

# Missing behaviour ----------------------------------------------------------

a3 <- data_frame(
  a = c(1:3, NA),
  b = factor(c(1:3, NA)),
  c = factor(c(1:3, NA), exclude = NULL)
)

test_that("missing values get a panel", {
  wrap_a <- panel_layout(facet_wrap(~a), list(a3))
  wrap_b <- panel_layout(facet_wrap(~b), list(a3))
  wrap_c <- panel_layout(facet_wrap(~c), list(a3))
  grid_a <- panel_layout(facet_grid(a~.), list(a3))
  grid_b <- panel_layout(facet_grid(b~.), list(a3))
  grid_c <- panel_layout(facet_grid(c~.), list(a3))

  expect_equal(nrow(wrap_a), 4)
  expect_equal(nrow(wrap_b), 4)
  expect_equal(nrow(wrap_c), 4)
  expect_equal(nrow(grid_a), 4)
  expect_equal(nrow(grid_b), 4)
  expect_equal(nrow(grid_c), 4)
})

# Input checking ----------------------------------------------------------

test_that("facet_wrap throws errors at bad layout specs", {
  expect_snapshot_error(facet_wrap(~test, ncol = 1:4))
  expect_snapshot_error(facet_wrap(~test, ncol = -1))
  expect_snapshot_error(facet_wrap(~test, ncol = 1.5))

  expect_snapshot_error(facet_wrap(~test, nrow = 1:4))
  expect_snapshot_error(facet_wrap(~test, nrow = -1))
  expect_snapshot_error(facet_wrap(~test, nrow = 1.5))

  expect_snapshot_warning(facet_wrap(~test, nrow = 2, space = "free_x"))

  p <- ggplot(mtcars) +
    geom_point(aes(mpg, disp)) +
    facet_wrap(~gear, ncol = 1, nrow = 1)
  expect_snapshot_error(ggplot_build(p))

  p <- ggplot(mtcars) +
    geom_point(aes(mpg, disp)) +
    facet_wrap(~gear, scales = "free") +
    coord_fixed()
  expect_snapshot_error(ggplotGrob(p))
})

test_that("facet_grid throws errors at bad layout specs", {
  p <- ggplot(mtcars) +
    geom_point(aes(mpg, disp)) +
    facet_grid(.~gear, scales = "free") +
    coord_fixed()
  expect_snapshot_error(ggplotGrob(p))
  p <- ggplot(mtcars) +
    geom_point(aes(mpg, disp)) +
    facet_grid(.~gear, space = "free") +
    theme(aspect.ratio = 1)
  expect_snapshot_error(ggplotGrob(p))
})

test_that("facet_grid can respect coord aspect with free scales/space", {
  df <- expand.grid(x = letters[1:6], y = LETTERS[1:3])
  p <- ggplot(df, aes(x, y)) +
    geom_tile() +
    facet_grid(
      rows = vars(y == "C"),
      cols = vars(x %in% c("e", "f")),
      scales = "free", space = "free"
    ) +
    coord_fixed(3, expand = FALSE)
  gt <- ggplotGrob(p)
  width  <- gt$widths[panel_cols(gt)$l]
  height <- gt$heights[panel_rows(gt)$t]
  expect_equal(as.numeric(width),  c(4, 2))
  expect_equal(as.numeric(height), c(6, 3))
})

test_that("facet_wrap and facet_grid throws errors when using reserved words", {
  mtcars2 <- mtcars
  mtcars2$PANEL <- mtcars2$cyl
  mtcars2$ROW <- mtcars2$gear

  p <- ggplot(mtcars2) +
    geom_point(aes(mpg, disp))
  expect_snapshot_error(ggplotGrob(p + facet_grid(ROW ~ gear)))
  expect_snapshot_error(ggplotGrob(p + facet_grid(ROW ~ PANEL)))
  expect_snapshot_error(ggplotGrob(p + facet_wrap(~ROW)))
})