Nothing
strip_layout <- function(p) {
data <- ggplot_build(p)
plot <- data$plot
layout <- data$layout
data <- data$data
theme <- ggplot2:::plot_theme(plot)
geom_grobs <- Map(function(l, d) { l$draw_geom(d, layout) },
plot$layers, data)
facet <- layout$render(geom_grobs, data, theme, plot$labels)
layout <- facet$layout
strip_layout <- layout[grepl("^strip", layout$name), 1:4]
as.list(strip_layout)
}
p <- ggplot(mtcars, aes(disp, drat)) + geom_point()
test_that("facet_wrap2() builds correct output", {
wrap <- p + facet_wrap2(~cyl, axes = "all", remove_labels = "y")
wrap_expected <- list(
t = c(3, 3, 3),
l = c(3, 7, 11),
b = c(3, 3, 3),
r = c(3, 7, 11)
)
expect_equal(strip_layout(wrap), wrap_expected)
})
grab_axis <- function(gt, where = "b") {
gt$grobs[grepl(paste0("^axis-", where), gt$layout$name)]
}
nchildren <- function(gt, where) {
axis <- grab_axis(gt, where)
vapply(axis, function(x){
if (!length(x$children)) {
return(0L)
}
x <- x$children
x <- x[names(x) == "axis"][[1]]
length(x$grobs)
}, integer(1))
}
test_that("facet_wrap2() can some repeat axes", {
case <- p + facet_wrap2(am ~ cyl, axes = "x", dir = "v")
ctrl <- p + facet_wrap2(am ~ cyl, axes = "margins", dir = "v")
case <- ggplotGrob(case)
ctrl <- ggplotGrob(ctrl)
case <- grab_axis(case, "b")
ctrl <- grab_axis(ctrl, "b")
case <- vapply(case, ggplot2:::is.zero, logical(1))
ctrl <- vapply(ctrl, ggplot2:::is.zero, logical(1))
expect_equal(sum(case), 0L)
expect_equal(sum(ctrl), 4L)
})
test_that("facet_wrap2 respects aspect ratio", {
case_null <- p + facet_wrap2(~ vs)
case_asp <- case_null + theme(aspect.ratio = 2)
case_null <- ggplotGrob(case_null)
case_asp <- ggplotGrob(case_asp)
panel_col <- panel_cols(case_null)$l
panel_row <- panel_rows(case_null)$t
expect_equal(as.character(case_null$widths[panel_col]), c("1null", "1null"))
expect_equal(as.character(case_asp$widths[panel_col]), c("1null", "1null"))
expect_equal(as.character(case_null$heights[panel_row]), "1null")
expect_equal(as.character(case_asp$heights[panel_row]), "2null")
expect_false(case_null$respect)
expect_true(case_asp$respect)
})
test_that("facet_wrap2() can remove some labels", {
case1 <- p + facet_wrap2(am~cyl, axes = "all", remove_labels = "y")
case2 <- p + facet_wrap2(am~cyl, axes = "all", remove_labels = "x")
ctrl1 <- p + facet_wrap2(am~cyl, axes = "margins")
ctrl2 <- p + facet_wrap2(am~cyl, axes = "all", remove_labels = "none")
# Convert to gtables
case1 <- ggplotGrob(case1)
case2 <- ggplotGrob(case2)
ctrl1 <- ggplotGrob(ctrl1)
ctrl2 <- ggplotGrob(ctrl2)
# Compare x-axis
if (!new_guide_system) {
expect_equal(nchildren(case1, "b"), rep(2L, 6))
expect_equal(nchildren(case2, "b"), c(2L, 2L, 2L, 1L, 1L, 1L))
expect_equal(nchildren(ctrl1, "b"), c(2L, 2L, 2L, 0L, 0L, 0L))
expect_equal(nchildren(ctrl2, "b"), rep(2L, 6))
} else {
expect_equal(nchildren(case1, "b"), rep(3L, 6))
expect_equal(nchildren(case2, "b"), c(3L, 3L, 3L, 2L, 2L, 2L))
expect_equal(nchildren(ctrl1, "b"), c(3L, 3L, 3L, 0L, 0L, 0L))
expect_equal(nchildren(ctrl2, "b"), rep(3L, 6))
}
# Compare y-axis
if (!new_guide_system) {
expect_equal(nchildren(case1, "l"), c(1L, 1L, 1L, 1L, 2L, 2L))
expect_equal(nchildren(case2, "l"), rep(2L, 6))
expect_equal(nchildren(ctrl1, "l"), c(0L, 0L, 0L, 0L, 2L, 2L))
expect_equal(nchildren(ctrl2, "l"), rep(2L, 6))
} else {
expect_equal(nchildren(case1, "l"), c(2L, 2L, 2L, 2L, 3L, 3L))
expect_equal(nchildren(case2, "l"), rep(3L, 6))
expect_equal(nchildren(ctrl1, "l"), c(0L, 0L, 0L, 0L, 3L, 3L))
expect_equal(nchildren(ctrl2, "l"), rep(3L, 6))
}
})
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.