1context("Guides") 2 3skip_on_cran() # This test suite is long-running (on cran) and is skipped 4 5test_that("colourbar trains without labels", { 6 g <- guide_colorbar() 7 sc <- scale_colour_continuous(limits = c(0, 4), labels = NULL) 8 9 out <- guide_train(g, sc) 10 expect_equal(names(out$key), c("colour", ".value")) 11}) 12 13test_that("Colorbar respects show.legend in layer", { 14 df <- data_frame(x = 1:3, y = 1) 15 p <- ggplot(df, aes(x = x, y = y, color = x)) + 16 geom_point(size = 20, shape = 21, show.legend = FALSE) 17 expect_false("guide-box" %in% ggplotGrob(p)$layout$name) 18 p <- ggplot(df, aes(x = x, y = y, color = x)) + 19 geom_point(size = 20, shape = 21, show.legend = TRUE) 20 expect_true("guide-box" %in% ggplotGrob(p)$layout$name) 21}) 22 23test_that("show.legend handles named vectors", { 24 n_legends <- function(p) { 25 g <- ggplotGrob(p) 26 gb <- which(g$layout$name == "guide-box") 27 if (length(gb) > 0) { 28 n <- length(g$grobs[[gb]]) - 1 29 } else { 30 n <- 0 31 } 32 n 33 } 34 35 df <- data_frame(x = 1:3, y = 20:22) 36 p <- ggplot(df, aes(x = x, y = y, color = x, shape = factor(y))) + 37 geom_point(size = 20) 38 expect_equal(n_legends(p), 2) 39 40 p <- ggplot(df, aes(x = x, y = y, color = x, shape = factor(y))) + 41 geom_point(size = 20, show.legend = c(color = FALSE)) 42 expect_equal(n_legends(p), 1) 43 44 p <- ggplot(df, aes(x = x, y = y, color = x, shape = factor(y))) + 45 geom_point(size = 20, show.legend = c(color = FALSE, shape = FALSE)) 46 expect_equal(n_legends(p), 0) 47 48 # c.f.https://github.com/tidyverse/ggplot2/issues/3461 49 p <- ggplot(df, aes(x = x, y = y, color = x, shape = factor(y))) + 50 geom_point(size = 20, show.legend = c(shape = FALSE, color = TRUE)) 51 expect_equal(n_legends(p), 1) 52}) 53 54test_that("axis_label_overlap_priority always returns the correct number of elements", { 55 expect_identical(axis_label_priority(0), numeric(0)) 56 expect_setequal(axis_label_priority(1), seq_len(1)) 57 expect_setequal(axis_label_priority(5), seq_len(5)) 58 expect_setequal(axis_label_priority(10), seq_len(10)) 59 expect_setequal(axis_label_priority(100), seq_len(100)) 60}) 61 62test_that("axis_label_element_overrides errors when angles are outside the range [0, 90]", { 63 expect_is(axis_label_element_overrides("bottom", 0), "element") 64 expect_error(axis_label_element_overrides("bottom", 91), "`angle` must") 65 expect_error(axis_label_element_overrides("bottom", -91), "`angle` must") 66}) 67 68test_that("a warning is generated when guides are drawn at a location that doesn't make sense", { 69 plot <- ggplot(mpg, aes(class, hwy)) + 70 geom_point() + 71 scale_y_continuous(guide = guide_axis(position = "top")) 72 built <- expect_silent(ggplot_build(plot)) 73 expect_warning(ggplot_gtable(built), "Position guide is perpendicular") 74}) 75 76test_that("a warning is not generated when a guide is specified with duplicate breaks", { 77 plot <- ggplot(mpg, aes(class, hwy)) + 78 geom_point() + 79 scale_y_continuous(breaks = c(20, 20)) 80 built <- expect_silent(ggplot_build(plot)) 81 expect_silent(ggplot_gtable(built)) 82}) 83 84test_that("a warning is generated when more than one position guide is drawn at a location", { 85 plot <- ggplot(mpg, aes(class, hwy)) + 86 geom_point() + 87 guides( 88 y = guide_axis(position = "left"), 89 y.sec = guide_axis(position = "left") 90 ) 91 built <- expect_silent(ggplot_build(plot)) 92 expect_warning(ggplot_gtable(built), "Discarding guide") 93}) 94 95test_that("a warning is not generated when properly changing the position of a guide_axis()", { 96 plot <- ggplot(mpg, aes(class, hwy)) + 97 geom_point() + 98 guides( 99 y = guide_axis(position = "right") 100 ) 101 built <- expect_silent(ggplot_build(plot)) 102 expect_silent(ggplot_gtable(built)) 103}) 104 105test_that("guide_none() can be used in non-position scales", { 106 p <- ggplot(mpg, aes(cty, hwy, colour = class)) + 107 geom_point() + 108 scale_color_discrete(guide = guide_none()) 109 110 built <- ggplot_build(p) 111 plot <- built$plot 112 guides <- build_guides( 113 plot$scales, 114 plot$layers, 115 plot$mapping, 116 "right", 117 theme_gray(), 118 plot$guides, 119 plot$labels 120 ) 121 122 expect_identical(guides, zeroGrob()) 123}) 124 125test_that("Using non-position guides for position scales results in an informative error", { 126 p <- ggplot(mpg, aes(cty, hwy)) + 127 geom_point() + 128 scale_x_continuous(guide = guide_legend()) 129 130 built <- ggplot_build(p) 131 expect_error(ggplot_gtable(built), "does not implement guide_transform()") 132}) 133 134test_that("guide merging for guide_legend() works as expected", { 135 136 merge_test_guides <- function(scale1, scale2) { 137 scale1$guide <- guide_legend(direction = "vertical") 138 scale2$guide <- guide_legend(direction = "vertical") 139 scales <- scales_list() 140 scales$add(scale1) 141 scales$add(scale2) 142 143 guide_list <- guides_train(scales, theme = theme_gray(), labels = labs(), guides = guides()) 144 guides_merge(guide_list) 145 } 146 147 different_limits <- merge_test_guides( 148 scale_colour_discrete(limits = c("a", "b", "c", "d")), 149 scale_linetype_discrete(limits = c("a", "b", "c")) 150 ) 151 expect_length(different_limits, 2) 152 153 same_limits <- merge_test_guides( 154 scale_colour_discrete(limits = c("a", "b", "c")), 155 scale_linetype_discrete(limits = c("a", "b", "c")) 156 ) 157 expect_length(same_limits, 1) 158 expect_equal(same_limits[[1]]$key$.label, c("a", "b", "c")) 159 160 same_labels_different_limits <- merge_test_guides( 161 scale_colour_discrete(limits = c("a", "b", "c")), 162 scale_linetype_discrete(limits = c("one", "two", "three"), labels = c("a", "b", "c")) 163 ) 164 expect_length(same_labels_different_limits, 1) 165 expect_equal(same_labels_different_limits[[1]]$key$.label, c("a", "b", "c")) 166 167 same_labels_different_scale <- merge_test_guides( 168 scale_colour_continuous(limits = c(0, 4), breaks = 1:3, labels = c("a", "b", "c")), 169 scale_linetype_discrete(limits = c("a", "b", "c")) 170 ) 171 expect_length(same_labels_different_scale, 1) 172 expect_equal(same_labels_different_scale[[1]]$key$.label, c("a", "b", "c")) 173 174 repeated_identical_labels <- merge_test_guides( 175 scale_colour_discrete(limits = c("one", "two", "three"), labels = c("label1", "label1", "label2")), 176 scale_linetype_discrete(limits = c("1", "2", "3"), labels = c("label1", "label1", "label2")) 177 ) 178 expect_length(repeated_identical_labels, 1) 179 expect_equal(repeated_identical_labels[[1]]$key$.label, c("label1", "label1", "label2")) 180}) 181 182# Visual tests ------------------------------------------------------------ 183 184test_that("axis guides are drawn correctly", { 185 theme_test_axis <- theme_test() + theme(axis.line = element_line(size = 0.5)) 186 test_draw_axis <- function(n_breaks = 3, 187 break_positions = seq_len(n_breaks) / (n_breaks + 1), 188 labels = as.character, 189 positions = c("top", "right", "bottom", "left"), 190 theme = theme_test_axis, 191 ...) { 192 193 break_labels <- labels(seq_along(break_positions)) 194 195 # create the axes 196 axes <- lapply(positions, function(position) { 197 draw_axis(break_positions, break_labels, axis_position = position, theme = theme, ...) 198 }) 199 axes_grob <- gTree(children = do.call(gList, axes)) 200 201 # arrange them so there's some padding on each side 202 gt <- gtable( 203 widths = unit(c(0.05, 0.9, 0.05), "npc"), 204 heights = unit(c(0.05, 0.9, 0.05), "npc") 205 ) 206 gt <- gtable_add_grob(gt, list(axes_grob), 2, 2, clip = "off") 207 plot(gt) 208 } 209 210 # basic 211 expect_doppelganger("axis guides basic", function() test_draw_axis()) 212 expect_doppelganger("axis guides, zero breaks", function() test_draw_axis(n_breaks = 0)) 213 214 # overlapping text 215 expect_doppelganger( 216 "axis guides, check overlap", 217 function() test_draw_axis(20, labels = function(b) comma(b * 1e9), check.overlap = TRUE) 218 ) 219 220 # rotated text 221 expect_doppelganger( 222 "axis guides, zero rotation", 223 function() test_draw_axis(10, labels = function(b) comma(b * 1e3), angle = 0) 224 ) 225 226 expect_doppelganger( 227 "axis guides, positive rotation", 228 function() test_draw_axis(10, labels = function(b) comma(b * 1e3), angle = 45) 229 ) 230 231 expect_doppelganger( 232 "axis guides, negative rotation", 233 function() test_draw_axis(10, labels = function(b) comma(b * 1e3), angle = -45) 234 ) 235 236 expect_doppelganger( 237 "axis guides, vertical rotation", 238 function() test_draw_axis(10, labels = function(b) comma(b * 1e3), angle = 90) 239 ) 240 241 expect_doppelganger( 242 "axis guides, vertical negative rotation", 243 function() test_draw_axis(10, labels = function(b) comma(b * 1e3), angle = -90) 244 ) 245 246 # dodged text 247 expect_doppelganger( 248 "axis guides, text dodged into rows/cols", 249 function() test_draw_axis(10, labels = function(b) comma(b * 1e9), n.dodge = 2) 250 ) 251}) 252 253test_that("axis guides are drawn correctly in plots", { 254 expect_doppelganger("align facet labels, facets horizontal", 255 qplot(hwy, reorder(model, hwy), data = mpg) + 256 facet_grid(manufacturer ~ ., scales = "free", space = "free") + 257 theme_test() + 258 theme(strip.text.y = element_text(angle = 0)) 259 ) 260 expect_doppelganger("align facet labels, facets vertical", 261 qplot(reorder(model, hwy), hwy, data = mpg) + 262 facet_grid(. ~ manufacturer, scales = "free", space = "free") + 263 theme_test() + 264 theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5)) 265 ) 266 expect_doppelganger("thick axis lines", 267 qplot(wt, mpg, data = mtcars) + 268 theme_test() + 269 theme(axis.line = element_line(size = 5, lineend = "square")) 270 ) 271}) 272 273test_that("axis guides can be customized", { 274 plot <- ggplot(mpg, aes(class, hwy)) + 275 geom_point() + 276 scale_y_continuous( 277 sec.axis = dup_axis(guide = guide_axis(n.dodge = 2)), 278 guide = guide_axis(n.dodge = 2) 279 ) + 280 scale_x_discrete(guide = guide_axis(n.dodge = 2)) 281 282 expect_doppelganger("guide_axis() customization", plot) 283}) 284 285test_that("guides can be specified in guides()", { 286 plot <- ggplot(mpg, aes(class, hwy)) + 287 geom_point() + 288 guides( 289 x = guide_axis(n.dodge = 2), 290 y = guide_axis(n.dodge = 2), 291 x.sec = guide_axis(n.dodge = 2), 292 y.sec = guide_axis(n.dodge = 2) 293 ) 294 295 expect_doppelganger("guides specified in guides()", plot) 296}) 297 298test_that("guides have the final say in x and y", { 299 df <- data_frame(x = 1, y = 1) 300 plot <- ggplot(df, aes(x, y)) + 301 geom_point() + 302 guides( 303 x = guide_none(title = "x (primary)"), 304 y = guide_none(title = "y (primary)"), 305 x.sec = guide_none(title = "x (secondary)"), 306 y.sec = guide_none(title = "y (secondary)") 307 ) 308 309 expect_doppelganger("position guide titles", plot) 310}) 311 312test_that("guides are positioned correctly", { 313 df <- data_frame(x = 1, y = 1, z = factor("a")) 314 315 p1 <- ggplot(df, aes(x, y, colour = z)) + 316 geom_point() + 317 labs(title = "title of plot") + 318 theme_test() + 319 theme( 320 axis.text.x = element_text(angle = 90, vjust = 0.5), 321 legend.background = element_rect(fill = "grey90"), 322 legend.key = element_rect(fill = "grey90") 323 ) + 324 scale_x_continuous(breaks = 1, labels = "very long axis label") + 325 scale_y_continuous(breaks = 1, labels = "very long axis label") 326 327 expect_doppelganger("legend on left", 328 p1 + theme(legend.position = "left") 329 ) 330 expect_doppelganger("legend on bottom", 331 p1 + theme(legend.position = "bottom") 332 ) 333 expect_doppelganger("legend on right", 334 p1 + theme(legend.position = "right") 335 ) 336 expect_doppelganger("legend on top", 337 p1 + theme(legend.position = "top") 338 ) 339 expect_doppelganger("facet_grid, legend on left", 340 p1 + facet_grid(x~y) + theme(legend.position = "left") 341 ) 342 expect_doppelganger("facet_grid, legend on bottom", 343 p1 + facet_grid(x~y) + theme(legend.position = "bottom") 344 ) 345 expect_doppelganger("facet_grid, legend on right", 346 p1 + facet_grid(x~y) + theme(legend.position = "right") 347 ) 348 expect_doppelganger("facet_grid, legend on top", 349 p1 + facet_grid(x~y) + theme(legend.position = "top") 350 ) 351 expect_doppelganger("facet_wrap, legend on left", 352 p1 + facet_wrap(~ x) + theme(legend.position = "left") 353 ) 354 expect_doppelganger("facet_wrap, legend on bottom", 355 p1 + facet_wrap(~ x) + theme(legend.position = "bottom") 356 ) 357 expect_doppelganger("facet_wrap, legend on right", 358 p1 + facet_wrap(~ x) + theme(legend.position = "right") 359 ) 360 expect_doppelganger("facet_wrap, legend on top", 361 p1 + facet_wrap(~ x) + theme(legend.position = "top") 362 ) 363 364 # padding 365 dat <- data_frame(x = LETTERS[1:3], y = 1) 366 p2 <- ggplot(dat, aes(x, y, fill = x, colour = 1:3)) + 367 geom_bar(stat = "identity") + 368 guides(color = "colorbar") + 369 theme_test() + 370 theme(legend.background = element_rect(colour = "black")) 371 372 expect_doppelganger("padding in legend box", p2) 373 374 # Placement of legend inside 375 expect_doppelganger("legend inside plot, centered", 376 p2 + theme(legend.position = c(.5, .5)) 377 ) 378 expect_doppelganger("legend inside plot, bottom left", 379 p2 + theme(legend.justification = c(0,0), legend.position = c(0,0)) 380 ) 381 expect_doppelganger("legend inside plot, top right", 382 p2 + theme(legend.justification = c(1,1), legend.position = c(1,1)) 383 ) 384 expect_doppelganger("legend inside plot, bottom left of legend at center", 385 p2 + theme(legend.justification = c(0,0), legend.position = c(.5,.5)) 386 ) 387}) 388 389test_that("guides title and text are positioned correctly", { 390 df <- data_frame(x = 1:3, y = 1:3) 391 p <- ggplot(df, aes(x, y, color = factor(x), fill = y)) + 392 geom_point(shape = 21) + 393 # setting the order explicitly removes the risk for failed doppelgangers 394 # due to legends switching order 395 guides(color = guide_legend(order = 2), 396 fill = guide_colorbar(order = 1)) + 397 theme_test() 398 399 expect_doppelganger("multi-line guide title works", 400 p + 401 scale_color_discrete(name = "the\ndiscrete\ncolorscale") + 402 scale_fill_continuous(name = "the\ncontinuous\ncolorscale") 403 ) 404 expect_doppelganger("vertical gap of 1cm between guide title and guide", 405 p + theme(legend.spacing.y = grid::unit(1, "cm")) 406 ) 407 expect_doppelganger("horizontal gap of 1cm between guide and guide text", 408 p + theme(legend.spacing.x = grid::unit(1, "cm")) 409 ) 410 411 # now test label positioning, alignment, etc 412 df <- data_frame(x = c(1, 10, 100)) 413 p <- ggplot(df, aes(x, x, color = x, size = x)) + 414 geom_point() + 415 # setting the order explicitly removes the risk for failed doppelgangers 416 # due to legends switching order 417 guides(shape = guide_legend(order = 1), 418 color = guide_colorbar(order = 2)) + 419 theme_test() 420 421 expect_doppelganger("guide title and text positioning and alignment via themes", 422 p + theme( 423 legend.title = element_text(hjust = 0.5, margin = margin(t = 30)), 424 legend.text = element_text(hjust = 1, margin = margin(l = 5, t = 10, b = 10)) 425 ) 426 ) 427 428 # title and label rotation 429 df <- data_frame(x = c(5, 10, 15)) 430 p <- ggplot(df, aes(x, x, color = x, fill = 15 - x)) + 431 geom_point(shape = 21, size = 5, stroke = 3) + 432 scale_colour_continuous( 433 name = "value", 434 guide = guide_colorbar( 435 title.theme = element_text(size = 11, angle = 0, hjust = 0.5, vjust = 1), 436 label.theme = element_text(size = 0.8*11, angle = 270, hjust = 0.5, vjust = 1), 437 order = 2 # set guide order to keep visual test stable 438 ) 439 ) + 440 scale_fill_continuous( 441 breaks = c(5, 10, 15), 442 limits = c(5, 15), 443 labels = paste("long", c(5, 10, 15)), 444 name = "fill value", 445 guide = guide_legend( 446 direction = "horizontal", 447 title.position = "top", 448 label.position = "bottom", 449 title.theme = element_text(size = 11, angle = 180, hjust = 0, vjust = 1), 450 label.theme = element_text(size = 0.8*11, angle = 90, hjust = 1, vjust = 0.5), 451 order = 1 452 ) 453 ) 454 455 expect_doppelganger("rotated guide titles and labels", p ) 456}) 457 458test_that("colorbar can be styled", { 459 df <- data_frame(x = c(0, 1, 2)) 460 p <- ggplot(df, aes(x, x, color = x)) + geom_point() 461 462 expect_doppelganger("white-to-red colorbar, white ticks, no frame", 463 p + scale_color_gradient(low = 'white', high = 'red') 464 ) 465 466 expect_doppelganger("white-to-red colorbar, thick black ticks, green frame", 467 p + scale_color_gradient( 468 low = 'white', high = 'red', 469 guide = guide_colorbar( 470 frame.colour = "green", 471 frame.linewidth = 1.5, 472 ticks.colour = "black", 473 ticks.linewidth = 2.5 474 ) 475 ) 476 ) 477}) 478 479test_that("guides can handle multiple aesthetics for one scale", { 480 df <- data_frame(x = c(1, 2, 3), 481 y = c(6, 5, 7)) 482 483 p <- ggplot(df, aes(x, y, color = x, fill = y)) + 484 geom_point(shape = 21, size = 3, stroke = 2) + 485 scale_colour_viridis_c( 486 name = "value", 487 option = "B", aesthetics = c("colour", "fill") 488 ) 489 490 expect_doppelganger("one combined colorbar for colour and fill aesthetics", p) 491}) 492 493test_that("bin guide can be styled correctly", { 494 df <- data_frame(x = c(1, 2, 3), 495 y = c(6, 5, 7)) 496 497 p <- ggplot(df, aes(x, y, size = x)) + 498 geom_point() + 499 scale_size_binned() 500 501 expect_doppelganger("guide_bins looks as it should", p) 502 expect_doppelganger("guide_bins can show limits", 503 p + guides(size = guide_bins(show.limits = TRUE)) 504 ) 505 expect_doppelganger("guide_bins can show arrows", 506 p + guides(size = guide_bins(axis.arrow = arrow(length = unit(1.5, "mm"), ends = "both"))) 507 ) 508 expect_doppelganger("guide_bins can remove axis", 509 p + guides(size = guide_bins(axis = FALSE)) 510 ) 511 expect_doppelganger("guide_bins work horizontally", 512 p + guides(size = guide_bins(direction = "horizontal")) 513 ) 514}) 515 516test_that("coloursteps guide can be styled correctly", { 517 df <- data_frame(x = c(1, 2, 4), 518 y = c(6, 5, 7)) 519 520 p <- ggplot(df, aes(x, y, colour = x)) + 521 geom_point() + 522 scale_colour_binned(breaks = c(1.5, 2, 3)) 523 524 expect_doppelganger("guide_coloursteps looks as it should", p) 525 expect_doppelganger("guide_coloursteps can show limits", 526 p + guides(colour = guide_coloursteps(show.limits = TRUE)) 527 ) 528 expect_doppelganger("guide_coloursteps can have bins relative to binsize", 529 p + guides(colour = guide_coloursteps(even.steps = FALSE)) 530 ) 531 expect_doppelganger("guide_bins can show ticks", 532 p + guides(colour = guide_coloursteps(ticks = TRUE)) 533 ) 534}) 535 536test_that("a warning is generated when guides(<scale> = FALSE) is specified", { 537 df <- data_frame(x = c(1, 2, 4), 538 y = c(6, 5, 7)) 539 540 # warn on guide(<scale> = FALSE) 541 expect_warning(g <- guides(colour = FALSE), "`guides(<scale> = FALSE)` is deprecated.", fixed = TRUE) 542 expect_equal(g[["colour"]], "none") 543 544 # warn on scale_*(guide = FALSE) 545 p <- ggplot(df, aes(x, y, colour = x)) + scale_colour_continuous(guide = FALSE) 546 built <- expect_silent(ggplot_build(p)) 547 expect_warning(ggplot_gtable(built), "It is deprecated to specify `guide = FALSE`") 548}) 549