1context("Scales") 2 3test_that("building a plot does not affect its scales", { 4 dat <- data_frame(x = rnorm(20), y = rnorm(20)) 5 6 p <- ggplot(dat, aes(x, y)) + geom_point() 7 expect_equal(length(p$scales$scales), 0) 8 9 ggplot_build(p) 10 expect_equal(length(p$scales$scales), 0) 11}) 12 13test_that("ranges update only for variables listed in aesthetics", { 14 sc <- scale_alpha() 15 16 sc$train_df(data_frame(alpha = 1:10)) 17 expect_equal(sc$range$range, c(1, 10)) 18 19 sc$train_df(data_frame(alpha = 50)) 20 expect_equal(sc$range$range, c(1, 50)) 21 22 sc$train_df(data_frame(beta = 100)) 23 expect_equal(sc$range$range, c(1, 50)) 24 25 sc$train_df(data_frame()) 26 expect_equal(sc$range$range, c(1, 50)) 27}) 28 29test_that("mapping works", { 30 sc <- scale_alpha(range = c(0, 1), na.value = 0) 31 sc$train_df(data_frame(alpha = 1:10)) 32 33 expect_equal( 34 sc$map_df(data_frame(alpha = 1:10))[[1]], 35 seq(0, 1, length.out = 10) 36 ) 37 38 expect_equal(sc$map_df(data_frame(alpha = NA))[[1]], 0) 39 40 expect_equal( 41 sc$map_df(data_frame(alpha = c(-10, 11)))[[1]], 42 c(0, 0)) 43}) 44 45test_that("identity scale preserves input values", { 46 df <- data_frame(x = 1:3, z = factor(letters[1:3])) 47 48 # aesthetic-specific scales 49 p1 <- ggplot(df, 50 aes(x, z, colour = z, fill = z, shape = z, size = x, alpha = x)) + 51 geom_point() + 52 scale_colour_identity() + 53 scale_fill_identity() + 54 scale_shape_identity() + 55 scale_size_identity() + 56 scale_alpha_identity() 57 d1 <- layer_data(p1) 58 59 expect_equal(d1$colour, as.character(df$z)) 60 expect_equal(d1$fill, as.character(df$z)) 61 expect_equal(d1$shape, as.character(df$z)) 62 expect_equal(d1$size, as.numeric(df$z)) 63 expect_equal(d1$alpha, as.numeric(df$z)) 64 65 # generic scales 66 p2 <- ggplot(df, 67 aes(x, z, colour = z, fill = z, shape = z, size = x, alpha = x)) + 68 geom_point() + 69 scale_discrete_identity(aesthetics = c("colour", "fill", "shape")) + 70 scale_continuous_identity(aesthetics = c("size", "alpha")) 71 d2 <- layer_data(p2) 72 73 expect_equal(d1, d2) 74}) 75 76test_that("position scales are updated by all position aesthetics", { 77 df <- data_frame(x = 1:3, y = 1:3) 78 79 aesthetics <- list( 80 aes(xend = x, yend = x), 81 aes(xmin = x, ymin = x), 82 aes(xmax = x, ymax = x), 83 aes(xintercept = x, yintercept = y) 84 ) 85 86 base <- ggplot(df, aes(x = 1, y = 1)) + geom_point() 87 plots <- lapply(aesthetics, function(x) base %+% x) 88 ranges <- lapply(plots, pranges) 89 90 lapply(ranges, function(range) { 91 expect_equal(range$x[[1]], c(1, 3)) 92 expect_equal(range$y[[1]], c(1, 3)) 93 }) 94}) 95 96test_that("position scales generate after stats", { 97 df <- data_frame(x = factor(c(1, 1, 1))) 98 plot <- ggplot(df, aes(x)) + geom_bar() 99 ranges <- pranges(plot) 100 101 expect_equal(ranges$x[[1]], c("1")) 102 expect_equal(ranges$y[[1]], c(0, 3)) 103}) 104 105test_that("oob affects position values", { 106 dat <- data_frame(x = c("a", "b", "c"), y = c(1, 5, 10)) 107 base <- ggplot(dat, aes(x, y)) + 108 geom_col() + 109 annotate("point", x = "a", y = c(-Inf, Inf)) 110 111 y_scale <- function(limits, oob = censor) { 112 scale_y_continuous(limits = limits, oob = oob, expand = c(0, 0)) 113 } 114 base + scale_y_continuous(limits = c(-0,5)) 115 116 expect_warning(low_censor <- cdata(base + y_scale(c(0, 5), censor)), 117 "Removed 1 rows containing missing values") 118 expect_warning(mid_censor <- cdata(base + y_scale(c(3, 7), censor)), 119 "Removed 2 rows containing missing values") 120 121 low_squish <- cdata(base + y_scale(c(0, 5), squish)) 122 mid_squish <- cdata(base + y_scale(c(3, 7), squish)) 123 124 # Points are always at the top and bottom 125 expect_equal(low_censor[[2]]$y, c(0, 1)) 126 expect_equal(mid_censor[[2]]$y, c(0, 1)) 127 expect_equal(low_squish[[2]]$y, c(0, 1)) 128 expect_equal(mid_squish[[2]]$y, c(0, 1)) 129 130 # Bars depend on limits and oob 131 expect_equal(low_censor[[1]]$y, c(0.2, 1)) 132 expect_equal(mid_censor[[1]]$y, c(0.5)) 133 expect_equal(low_squish[[1]]$y, c(0.2, 1, 1)) 134 expect_equal(mid_squish[[1]]$y, c(0, 0.5, 1)) 135}) 136 137test_that("all-Inf layers are not used for determining the type of scale", { 138 d1 <- data_frame(x = c("a", "b")) 139 p1 <- ggplot(d1, aes(x, x)) + 140 # Inf is numeric, but means discrete values in this case 141 annotate("rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf, fill = "black") + 142 geom_point() 143 144 b1 <- ggplot_build(p1) 145 expect_s3_class(b1$layout$panel_scales_x[[1]], "ScaleDiscretePosition") 146 147 p2 <- ggplot() + 148 # If the layer non-Inf value, it's considered 149 annotate("rect", xmin = -Inf, xmax = 0, ymin = -Inf, ymax = Inf, fill = "black") 150 151 b2 <- ggplot_build(p2) 152 expect_s3_class(b2$layout$panel_scales_x[[1]], "ScaleContinuousPosition") 153}) 154 155test_that("scales are looked for in appropriate place", { 156 xlabel <- function(x) ggplot_build(x)$layout$panel_scales_x[[1]]$name 157 p0 <- qplot(mpg, wt, data = mtcars) + scale_x_continuous("0") 158 expect_equal(xlabel(p0), "0") 159 160 scale_x_continuous <- function(...) ggplot2::scale_x_continuous("1") 161 p1 <- qplot(mpg, wt, data = mtcars) 162 expect_equal(xlabel(p1), "1") 163 164 f <- function() { 165 scale_x_continuous <- function(...) ggplot2::scale_x_continuous("2") 166 qplot(mpg, wt, data = mtcars) 167 } 168 p2 <- f() 169 expect_equal(xlabel(p2), "2") 170 171 rm(scale_x_continuous) 172 p4 <- qplot(mpg, wt, data = mtcars) 173 expect_equal(xlabel(p4), waiver()) 174}) 175 176test_that("find_global searches in the right places", { 177 testenv <- new.env(parent = globalenv()) 178 179 # This should find the scale object in the package environment 180 expect_identical(find_global("scale_colour_hue", testenv), 181 ggplot2::scale_colour_hue) 182 183 # Set an object with the same name in the environment 184 testenv$scale_colour_hue <- "foo" 185 186 # Now it should return the new object 187 expect_identical(find_global("scale_colour_hue", testenv), "foo") 188 189 # If we search in the empty env, we should end up with the object 190 # from the ggplot2 namespace 191 expect_identical(find_global("scale_colour_hue", emptyenv()), 192 ggplot2::scale_colour_hue) 193}) 194 195test_that("scales warn when transforms introduces non-finite values", { 196 df <- data_frame(x = c(1e1, 1e5), y = c(0, 100)) 197 198 p <- ggplot(df, aes(x, y)) + 199 geom_point(size = 5) + 200 scale_y_log10() 201 202 expect_warning(ggplot_build(p), "Transformation introduced infinite values") 203}) 204 205test_that("scales get their correct titles through layout", { 206 df <- data_frame(x = c(1e1, 1e5), y = c(0, 100)) 207 208 p <- ggplot(df, aes(x, y)) + 209 geom_point(size = 5) 210 211 p <- ggplot_build(p) 212 expect_identical(p$layout$xlabel(p$plot$labels)$primary, "x") 213 expect_identical(p$layout$ylabel(p$plot$labels)$primary, "y") 214}) 215 216test_that("size and alpha scales throw appropriate warnings for factors", { 217 df <- data_frame( 218 x = 1:3, 219 y = 1:3, 220 d = LETTERS[1:3], 221 o = factor(LETTERS[1:3], ordered = TRUE) 222 ) 223 p <- ggplot(df, aes(x, y)) 224 225 # There should be warnings when unordered factors are mapped to size/alpha 226 expect_warning( 227 ggplot_build(p + geom_point(aes(size = d))), 228 "Using size for a discrete variable is not advised." 229 ) 230 expect_warning( 231 ggplot_build(p + geom_point(aes(alpha = d))), 232 "Using alpha for a discrete variable is not advised." 233 ) 234 # There should be no warnings for ordered factors 235 expect_warning(ggplot_build(p + geom_point(aes(size = o))), NA) 236 expect_warning(ggplot_build(p + geom_point(aes(alpha = o))), NA) 237}) 238 239test_that("shape scale throws appropriate warnings for factors", { 240 df <- data_frame( 241 x = 1:3, 242 y = 1:3, 243 d = LETTERS[1:3], 244 o = factor(LETTERS[1:3], ordered = TRUE) 245 ) 246 p <- ggplot(df, aes(x, y)) 247 248 # There should be no warnings when unordered factors are mapped to shape 249 expect_warning(ggplot_build(p + geom_point(aes(shape = d))), NA) 250 251 # There should be warnings for ordered factors 252 expect_warning( 253 ggplot_build(p + geom_point(aes(shape = o))), 254 "Using shapes for an ordinal variable is not advised" 255 ) 256}) 257 258test_that("aesthetics can be set independently of scale name", { 259 df <- data_frame( 260 x = LETTERS[1:3], 261 y = LETTERS[4:6] 262 ) 263 p <- ggplot(df, aes(x, y, fill = y)) + 264 scale_colour_manual(values = c("red", "green", "blue"), aesthetics = "fill") 265 266 expect_equal(layer_data(p)$fill, c("red", "green", "blue")) 267}) 268 269test_that("multiple aesthetics can be set with one function call", { 270 df <- data_frame( 271 x = LETTERS[1:3], 272 y = LETTERS[4:6] 273 ) 274 p <- ggplot(df, aes(x, y, colour = x, fill = y)) + 275 scale_colour_manual( 276 values = c("grey20", "grey40", "grey60", "red", "green", "blue"), 277 aesthetics = c("colour", "fill") 278 ) 279 280 expect_equal(layer_data(p)$colour, c("grey20", "grey40", "grey60")) 281 expect_equal(layer_data(p)$fill, c("red", "green", "blue")) 282 283 # color order is determined by data order, and breaks are combined where possible 284 df <- data_frame( 285 x = LETTERS[1:3], 286 y = LETTERS[2:4] 287 ) 288 p <- ggplot(df, aes(x, y, colour = x, fill = y)) + 289 scale_colour_manual( 290 values = c("cyan", "red", "green", "blue"), 291 aesthetics = c("fill", "colour") 292 ) 293 294 expect_equal(layer_data(p)$colour, c("cyan", "red", "green")) 295 expect_equal(layer_data(p)$fill, c("red", "green", "blue")) 296}) 297 298test_that("limits with NA are replaced with the min/max of the data for continuous scales", { 299 make_scale <- function(limits = NULL, data = NULL) { 300 scale <- continuous_scale("aesthetic", scale_name = "test", palette = identity, limits = limits) 301 if (!is.null(data)) { 302 scale$train(data) 303 } 304 scale 305 } 306 307 # emptiness 308 expect_true(make_scale()$is_empty()) 309 expect_false(make_scale(limits = c(0, 1))$is_empty()) 310 expect_true(make_scale(limits = c(0, NA))$is_empty()) 311 expect_true(make_scale(limits = c(NA, NA))$is_empty()) 312 expect_true(make_scale(limits = c(NA, 0))$is_empty()) 313 314 # limits 315 expect_equal(make_scale(data = 1:5)$get_limits(), c(1, 5)) 316 expect_equal(make_scale(limits = c(1, 5))$get_limits(), c(1, 5)) 317 expect_equal(make_scale(limits = c(NA, NA))$get_limits(), c(0, 1)) 318 expect_equal(make_scale(limits = c(NA, NA), data = 1:5)$get_limits(), c(1, 5)) 319 expect_equal(make_scale(limits = c(1, NA), data = 1:5)$get_limits(), c(1, 5)) 320 expect_equal(make_scale(limits = c(NA, 5), data = 1:5)$get_limits(), c(1, 5)) 321}) 322 323test_that("scale_apply preserves class and attributes", { 324 df <- data_frame( 325 x = structure(c(1, 2), foo = "bar", class = c("baz", "numeric")), 326 y = c(1, 1), 327 z = c("A", "B") 328 ) 329 330 # Functions to make the 'baz'-class more type stable 331 `c.baz` <- function(...) { 332 dots <- list(...) 333 attris <- attributes(dots[[1]]) 334 x <- do.call("c", lapply(dots, unclass)) 335 attributes(x) <- attris 336 x 337 } 338 `[.baz` <- function(x, i) { 339 attris <- attributes(x) 340 x <- unclass(x)[i] 341 attributes(x) <- attris 342 x 343 } 344 345 plot <- ggplot(df, aes(x, y)) + 346 scale_x_continuous() + 347 # Facetting such that 2 x-scales will exist, i.e. `x` will be subsetted 348 facet_grid(~ z, scales = "free_x") 349 plot <- ggplot_build(plot) 350 351 # Perform identity transformation via `scale_apply` 352 out <- with_bindings(scale_apply( 353 df, "x", "transform", 1:2, plot$layout$panel_scales_x 354 )[[1]], `c.baz` = `c.baz`, `[.baz` = `[.baz`, .env = global_env()) 355 356 # Check class preservation 357 expect_is(out, "baz") 358 expect_is(out, "numeric") 359 360 # Check attribute preservation 361 expect_identical(attr(out, "foo"), "bar") 362 363 # Negative control: non-type stable classes don't preserve attributes 364 class(df$x) <- "foobar" 365 366 out <- with_bindings(scale_apply( 367 df, "x", "transform", 1:2, plot$layout$panel_scales_x 368 )[[1]], `c.baz` = `c.baz`, `[.baz` = `[.baz`, .env = global_env()) 369 370 expect_false(inherits(out, "foobar")) 371 expect_null(attributes(out)) 372}) 373 374test_that("All scale_colour_*() have their American versions", { 375 # In testthat, the package env contains non-exported functions as well so we 376 # need to parse NAMESPACE file by ourselves 377 exports <- readLines(system.file("NAMESPACE", package = "ggplot2")) 378 colour_scale_exports <- grep("export\\(scale_colour_.*\\)", exports, value = TRUE) 379 color_scale_exports <- grep("export\\(scale_color_.*\\)", exports, value = TRUE) 380 expect_equal( 381 colour_scale_exports, 382 sub("color", "colour", color_scale_exports) 383 ) 384}) 385 386test_that("scales accept lambda notation for function input", { 387 check_lambda <- function(items, ggproto) { 388 vapply(items, function(x) { 389 f <- environment(ggproto[[x]])$f 390 is_lambda(f) 391 }, logical(1)) 392 } 393 394 # Test continuous scale 395 scale <- scale_fill_gradient( 396 limits = ~ .x + c(-1, 1), 397 breaks = ~ seq(.x[1], .x[2], by = 2), 398 minor_breaks = ~ seq(.x[1], .x[2], by = 1), 399 labels = ~ toupper(.x), 400 rescaler = ~ rescale_mid(.x, mid = 0), 401 oob = ~ oob_squish(.x, .y, only.finite = FALSE) 402 ) 403 check <- check_lambda( 404 c("limits", "breaks", "minor_breaks", "labels", "rescaler"), 405 scale 406 ) 407 expect_true(all(check)) 408 409 # Test discrete scale 410 scale <- scale_x_discrete( 411 limits = ~ rev(.x), 412 breaks = ~ .x[-1], 413 labels = ~ toupper(.x) 414 ) 415 check <- check_lambda(c("limits", "breaks", "labels"), scale) 416 expect_true(all(check)) 417 418 # Test binned scale 419 scale <- scale_fill_steps( 420 limits = ~ .x + c(-1, 1), 421 breaks = ~ seq(.x[1], .x[2], by = 2), 422 labels = ~ toupper(.x), 423 rescaler = ~ rescale_mid(.x, mid = 0), 424 oob = ~ oob_squish(.x, .y, only.finite = FALSE) 425 ) 426 check <- check_lambda( 427 c("limits", "breaks", "labels", "rescaler"), 428 scale 429 ) 430 expect_true(all(check)) 431}) 432