Nothing
test_that("guide_axis_nested work on x-axis", {
rlang::local_options(lifecycle_verbosity = "quiet")
g <- ggplot(mpg, aes(interaction(cyl, class), hwy)) +
geom_boxplot() +
scale_x_discrete(guide = "axis_nested")
gt <- ggplotGrob(g)
grob <- gt$grobs[gt$layout$name == "axis-b"][[1]]
grob <- grob$children[names(grob$children) == "axis"][[1]]
classes <- vapply(lapply(grob$grobs, class), `[`, character(1), 1)
names(classes) <- NULL
expect_equal(classes, c("polyline", "titleGrob", "polyline", "titleGrob"))
titles <- grob$grobs[classes == "titleGrob"]
small <- titles[[1]]$children[[1]]$label
large <- titles[[2]]$children[[1]]$label
expect_equal(length(small), nlevels(interaction(mpg$cyl, mpg$class, drop = T)))
expect_true(all(large %in% unique(mpg$class)))
})
test_that("guide_axis_nested work on y-axis", {
rlang::local_options(lifecycle_verbosity = "quiet")
g <- ggplot(mpg, aes(hwy, interaction(cyl, class))) +
geom_boxplot() +
scale_y_discrete(guide = "axis_nested")
gt <- ggplotGrob(g)
grob <- gt$grobs[gt$layout$name == "axis-l"][[1]]
grob <- grob$children[names(grob$children) == "axis"][[1]]
classes <- vapply(lapply(grob$grobs, class), `[`, character(1), 1)
names(classes) <- NULL
expect_equal(classes, c("titleGrob", "polyline", "titleGrob", "polyline"))
titles <- grob$grobs[classes == "titleGrob"]
large <- titles[[1]]$children[[1]]$label
small <- titles[[2]]$children[[1]]$label
expect_equal(length(small), nlevels(interaction(mpg$cyl, mpg$class, drop = T)))
expect_true(all(large %in% unique(mpg$class)))
})
test_that("guide_axis_nested work as secundary x-axis", {
rlang::local_options(lifecycle_verbosity = "quiet")
g <- ggplot(mpg, aes(interaction(cyl, class), hwy)) +
geom_boxplot() +
scale_x_discrete(position = "top", guide = "axis_nested")
gt <- ggplotGrob(g)
grob <- gt$grobs[gt$layout$name == "axis-t"][[1]]
grob <- grob$children[names(grob$children) == "axis"][[1]]
classes <- vapply(lapply(grob$grobs, class), `[`, character(1), 1)
names(classes) <- NULL
expect_equal(classes, c("titleGrob", "polyline", "titleGrob", "polyline"))
titles <- grob$grobs[classes == "titleGrob"]
large <- titles[[1]]$children[[1]]$label
small <- titles[[2]]$children[[1]]$label
expect_equal(length(small), nlevels(interaction(mpg$cyl, mpg$class, drop = T)))
expect_true(all(large %in% unique(mpg$class)))
})
test_that("guide_axis_nested works as secundary y-axis", {
rlang::local_options(lifecycle_verbosity = "quiet")
g <- ggplot(mpg, aes(hwy, interaction(cyl, class))) +
geom_boxplot() +
scale_y_discrete(guide = "axis_nested", position = "right")
gt <- ggplotGrob(g)
grob <- gt$grobs[gt$layout$name == "axis-r"][[1]]
grob <- grob$children[names(grob$children) == "axis"][[1]]
classes <- vapply(lapply(grob$grobs, class), `[`, character(1), 1)
names(classes) <- NULL
expect_equal(classes, c("polyline", "titleGrob", "polyline", "titleGrob"))
titles <- grob$grobs[classes == "titleGrob"]
small <- titles[[1]]$children[[1]]$label
large <- titles[[2]]$children[[1]]$label
expect_equal(length(small), nlevels(interaction(mpg$cyl, mpg$class, drop = T)))
expect_true(all(large %in% unique(mpg$class)))
})
test_that("NULL breaks return zeroGrob as labels", {
rlang::local_options(lifecycle_verbosity = "quiet")
g <- ggplot(mpg, aes(interaction(cyl, class), hwy)) +
geom_boxplot() +
scale_x_discrete(guide = "axis_nested", breaks = NULL)
g <- ggplotGrob(g)
g <- g$grobs[[which(g$layout$name == "axis-b")]]$children[[1]]
expect_s3_class(g, "zeroGrob")
})
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.