test_that("setting guide labels works", { expect_identical(xlab("my label")$x, "my label") expect_identical(labs(x = "my label")$x, "my label") expect_identical(ylab("my label")$y, "my label") expect_identical(labs(y = "my label")$y, "my label") # Plot titles expect_identical(labs(title = "my title")$title, "my title") expect_identical(labs(title = "my title", subtitle = "my subtitle")$subtitle, "my subtitle") # whole plot annotations expect_identical(labs(caption = "my notice")$caption, "my notice") expect_identical(labs(title = "my title", caption = "my notice")$caption, "my notice") expect_identical(labs(tag = "A)")$tag, "A)") expect_identical(labs(title = "my title", tag = "A)")$tag, "A)") # Colour expect_identical(labs(colour = "my label")$colour, "my label") # American spelling expect_identical(labs(color = "my label")$colour, "my label") # No extra elements exists expect_length(labs(title = "my title"), 1) # formal argument expect_length(labs(colour = "my label"), 1) # dot expect_length(labs(foo = "bar"), 1) # non-existent param # labs() has list-splicing semantics params <- list(title = "my title", tag = "A)") expect_identical(labs(!!!params)$tag, "A)") # NULL is preserved expect_length(labs(title = NULL), 1) # ggtitle works in the same way as labs() expect_identical(ggtitle("my title")$title, "my title") expect_identical( ggtitle("my title", subtitle = "my subtitle")$subtitle, "my subtitle" ) expect_equal( unclass(ggtitle("my title", subtitle = NULL)), list(title = "my title", subtitle = NULL), ignore_attr = TRUE ) }) test_that("Labels from default stat mapping are overwritten by default labels", { p <- ggplot(mpg, aes(displ, hwy)) + geom_density2d() labels <- get_labs(p) expect_equal(labels$colour[1], "colour") expect_true(attr(labels$colour, "fallback")) p <- p + geom_smooth(aes(color = drv), method = "lm", formula = y ~ x) expect_equal(get_labs(p)$colour, "drv") }) test_that("Labels can be extracted from attributes", { df <- mtcars attr(df$mpg, "label") <- "Miles per gallon" p <- ggplot(df, aes(mpg, disp)) + geom_point() labels <- get_labs(p) expect_equal(labels$x, "Miles per gallon") expect_equal(labels$y, "disp") }) test_that("Labels from static aesthetics are ignored (#6003)", { df <- data.frame(x = 1, y = 1, f = 1) p <- ggplot(df, aes(x, y, colour = f)) + geom_point() expect_equal(get_labs(p)$colour, "f") p <- ggplot(df, aes(x, y, colour = f)) + geom_point(colour = "blue") expect_null(get_labs(p)$colour) }) test_that("Labels from annotations are ignored (#6316)", { df <- data.frame(a = 1, b = 2) p <- ggplot(df, aes(a, b)) + annotate("point", x = 1, y = 2) + geom_point() labs <- get_labs(p) expect_equal(labs[c("x", "y")], list(x = "a", y = "b")) }) test_that("alt text is returned", { p <- ggplot(mtcars, aes(mpg, disp)) + geom_point() expect_equal(get_alt_text(p), "") p <- p + labs(alt = "An alt text") expect_equal(get_alt_text(p), "An alt text") }) test_that("alt text can take a function", { p <- ggplot(mpg, aes(class)) + geom_bar() + labs(alt = ~ generate_alt_text(.x)) expect_snapshot(get_alt_text(p)) }) test_that("get_alt_text checks dots", { expect_snapshot_warning(get_alt_text(ggplot(), foo = "bar")) }) test_that("warnings are thrown for unknown labels", { p <- ggplot(mtcars, aes(mpg, disp)) + geom_point() + labs( foo = "i don't exist", bar = function(x) "i don't exist either", qux = expression(me * neither) ) expect_snapshot(p <- ggplot_build(p)) }) test_that("plot.tag.position rejects invalid input", { p <- ggplot(mtcars, aes(mpg, disp)) + geom_point() + labs(tag = "Fig. A)") expect_snapshot_error( ggplotGrob(p + theme(plot.tag.position = TRUE)) ) expect_snapshot_error( ggplotGrob(p + theme(plot.tag.position = "foobar")) ) expect_snapshot( ggplotGrob(p + theme(plot.tag.position = c(0, 0.5, 1))), error = TRUE ) expect_snapshot( ggplotGrob(p + theme(plot.tag.position = c(0, 0), plot.tag.location = "margin")), error = TRUE ) }) test_that("position axis label hierarchy works as intended", { df <- data_frame(foo = c(1e1, 1e5), bar = c(0, 100)) p <- ggplot(df, aes(foo, bar)) + geom_point(size = 5) p <- ggplot_build(p) resolve_label <- function(x) p@layout$resolve_label(x, p@plot@labels) # In absence of explicit title, get title from mapping expect_identical( resolve_label(p@layout$panel_scales_x[[1]]), list(secondary = NULL, primary = "foo") ) expect_identical( resolve_label(p@layout$panel_scales_y[[1]]), list(primary = "bar", secondary = NULL) ) # Scale name overrules mapping label expect_identical( resolve_label(scale_x_continuous("Baz")), list(secondary = NULL, primary = "Baz") ) expect_identical( resolve_label(scale_y_continuous("Qux")), list(primary = "Qux", secondary = NULL) ) # Guide titles overrule scale names p@layout$setup_panel_guides( guides_list(list(x = guide_axis("quuX"), y = guide_axis("corgE"))), p@plot@layers ) expect_identical( resolve_label(scale_x_continuous("Baz")), list(secondary = NULL, primary = "quuX") ) expect_identical( resolve_label(scale_y_continuous("Qux")), list(primary = "corgE", secondary = NULL) ) # Secondary axis names work xsec <- scale_x_continuous("Baz", sec.axis = dup_axis(name = "grault")) expect_identical( resolve_label(xsec), list(secondary = "grault", primary = "quuX") ) ysec <- scale_y_continuous("Qux", sec.axis = dup_axis(name = "garply")) expect_identical( resolve_label(ysec), list(primary = "corgE", secondary = "garply") ) # Secondary guide titles override secondary axis names p@layout$setup_panel_guides( guides_list(list(x = guide_axis("quuX"), y = guide_axis("corgE"), x.sec = guide_axis("waldo"), y.sec = guide_axis("fred"))), p@plot@layers ) expect_identical( resolve_label(xsec), list(secondary = "waldo", primary = "quuX") ) ysec <- scale_y_continuous("Qux", sec.axis = dup_axis(name = "garply")) expect_identical( resolve_label(ysec), list(primary = "corgE", secondary = "fred") ) }) test_that("labels can be derived using functions", { p <- ggplot(mtcars, aes(disp, mpg, colour = drat, shape = factor(cyl))) + geom_point() + labs( y = to_upper_ascii, shape = function(x) gsub("factor", "foo", x) ) + scale_shape_discrete( name = to_upper_ascii, guide = guide_legend(title = function(x) paste0(x, "!!!")) ) + scale_x_continuous(name = to_upper_ascii) + guides(colour = guide_colourbar(title = to_upper_ascii)) labs <- get_labs(p) expect_equal(labs$shape, "FOO(CYL)!!!") expect_equal(labs$colour, "DRAT") expect_equal(labs$x, "DISP") expect_equal(labs$y, "MPG") }) test_that("moving guide positions lets titles follow", { df <- data_frame(foo = c(1e1, 1e5), bar = c(0, 100)) p <- ggplot(df, aes(foo, bar)) + geom_point(size = 5) p <- ggplot_build(p) # Default guide positions p@layout$setup_panel_guides( guides_list( list(x = guide_axis("baz", position = "bottom"), y = guide_axis("qux", position = "left")) ), p@plot@layers ) labs <- get_labs(p) expect <- list(x = "baz", x.sec = NULL, y = "qux", y.sec = NULL) expect_identical(labs[names(expect)], expect) # Guides at secondary positions p@layout$setup_panel_guides( guides_list( list(x = guide_axis("baz", position = "top"), y = guide_axis("qux", position = "right")) ), p@plot@layers ) labs <- get_labs(p) expect_identical(labs[names(expect)], expect) # Primary guides at secondary positions with # secondary guides at primary positions p@layout$setup_panel_guides( guides_list( list(x = guide_axis("baz", position = "top"), y = guide_axis("qux", position = "right"), x.sec = guide_axis("quux"), y.sec = guide_axis("corge")) ), p@plot@layers ) labs <- get_labs(p) expect[c("x.sec", "y.sec")] <- list("quux", "corge") expect_identical(labs[names(expect)], expect) }) test_that("label dictionaries work", { p <- ggplot(mtcars, aes(disp, mpg, shape = factor(cyl), size = drat)) + geom_point() + labs(dictionary = c( disp = "Displacement", mpg = "Miles per gallon", `factor(cyl)` = "Number of cylinders", drat = "Rear axle ratio" )) p <- ggplot_build(p) x <- p@layout$resolve_label(p@layout$panel_scales_x[[1]], p@plot@labels) expect_equal(x$primary, "Displacement") y <- p@layout$resolve_label(p@layout$panel_scales_y[[1]], p@plot@labels) expect_equal(y$primary, "Miles per gallon") shape <- p@plot@guides$get_params("shape")$title expect_equal(shape, "Number of cylinders") size <- p@plot@guides$get_params("size")$title expect_equal(size, "Rear axle ratio") }) # Visual tests ------------------------------------------------------------ test_that("tags are drawn correctly", { dat <- data_frame(x = 1:10, y = 10:1) p <- ggplot(dat, aes(x = x, y = y)) + geom_point() + labs(tag = "Fig. A)") expect_doppelganger("defaults", p) expect_doppelganger( "Tag in margin", p + theme(plot.tag.position = "bottom", plot.tag.location = "margin") ) expect_doppelganger( "Tag in panel, as character", p + theme(plot.tag.position = "topright", plot.tag.location = "panel") ) expect_doppelganger( "Tag in panel, as numeric", p + theme(plot.tag.position = c(0.25, 0.25), plot.tag.location = "panel") ) expect_doppelganger( "Tag in plot, as character", p + theme(plot.tag.position = "bottomleft", plot.tag.location = "plot") ) expect_doppelganger( "Tag in plot, as numeric", p + theme(plot.tag.position = c(0.05, 0.05), plot.tag.location = "plot") ) })