Nothing
# Setup basic plot --------------------------------------------------------
basic <- ggplot(mpg, aes(displ, hwy)) +
geom_point()
# Basic tests -------------------------------------------------------------
test_that("facet_nested_wrap can be added to a plot", {
g <- basic + facet_nested_wrap(vars(cyl, drv))
expect_s3_class(g$facet, "gg")
expect_s3_class(g$facet, "Facet")
expect_s3_class(g$facet, "FacetWrap2")
expect_s3_class(g$facet, "FacetNestedWrap")
})
test_that("facet_nested_wrap can be build", {
g <- basic + facet_nested_wrap(vars(cyl, drv), dir = "v")
g <- ggplot_build(g)
expect_s3_class(g, "ggplot_built")
expect_s3_class(g$layout, "gg")
})
test_that("facet_nested_wrap can be interpreted as gtable", {
test <- basic + facet_nested_wrap(vars(cyl, drv))
ctrl <- basic + facet_wrap(vars(cyl, drv))
test <- ggplotGrob(test)
ctrl <- ggplotGrob(ctrl)
expect_equal(class(ctrl), class(test))
expect_s3_class(test, "gtable")
})
default <- basic + facet_nested_wrap(vars(cyl, drv))
default_gtable <- ggplotGrob(default)
test_that("facet_nested_wrap doesn't nest 1-dimensional strips",{
test <- basic + facet_nested_wrap(vars(cyl))
ctrl <- basic + facet_wrap(vars(cyl))
test <- ggplotGrob(test)
ctrl <- ggplotGrob(ctrl)
test <- sum(grepl("strip", test$layout$name))
ctrl <- sum(grepl("strip", ctrl$layout$name))
expect_equal(test, ctrl)
})
test_that("facet_nested_wrap bleed argument works", {
test <- basic + facet_nested_wrap(vars(cyl, drv),
strip = strip_nested(bleed = TRUE))
test <- ggplotGrob(test)
ctrl <- default_gtable
test <- sum(grepl("strip", test$layout$name))
ctrl <- sum(grepl("strip", ctrl$layout$name))
expect_equal(test + 1, ctrl)
})
test_that("facet_nested_wrap nest_line parameter works", {
f <- quote(facet_nested_wrap(vars(cyl, drv), nest_line = element_rect()))
expect_error(eval(f))
f <- facet_nested_wrap(vars(cyl, drv), nest_line = FALSE)
expect_s3_class(f$params$nest_line, "element_blank")
f <- facet_nested_wrap(vars(cyl, drv), nest_line = TRUE)
expect_s3_class(f$params$nest_line, "element_line")
test <- basic + f
test <- ggplotGrob(test)
ctrl <- default_gtable
test <- test$grobs[test$layout$name == "strip-t-1-1"][[1]]
ctrl <- ctrl$grobs[ctrl$layout$name == "strip-t-1-1"][[1]]
expect_equal(length(test$grobs), length(ctrl$grobs) + 1)
expect_true("nester" %in% test$layout$name)
expect_false("nester" %in% ctrl$layout$name)
})
test_that("facet_nested_wrap all strip positions are OK", {
top <- basic + facet_nested_wrap(vars(cyl, drv),
strip.position = "top")
bottom <- basic + facet_nested_wrap(vars(cyl, drv),
strip.position = "bottom")
left <- basic + facet_nested_wrap(vars(cyl, drv),
strip.position = "left", dir = "v")
right <- basic + facet_nested_wrap(vars(cyl, drv),
strip.position = "right",
strip = strip_nested(bleed = TRUE))
tables <- lapply(list(top, bottom, left, right), ggplotGrob)
nstrips <- vapply(tables, function(gt) {
sum(grepl("strip", gt$layout$name))
}, numeric(1))
expect_equal(nstrips, c(13, 13, 13, 13))
})
test_that("facet_nested_wrap constructors throws appropriate warnings", {
x <- quote(facet_nested_wrap(vars(dummy), bleed = "dummy"))
expect_warning(eval(x))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.