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