File: test-scale-manual.r

package info (click to toggle)
r-cran-ggplot2 3.3.3%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 8,184 kB
  • sloc: sh: 15; makefile: 5
file content (99 lines) | stat: -rw-r--r-- 3,746 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
context("scale_manual")

test_that("names of values used in manual scales", {
   s <- scale_colour_manual(values = c("8" = "c","4" = "a","6" = "b"))
   s$train(c("4", "6", "8"))
   expect_equal(s$map(c("4", "6", "8")), c("a", "b", "c"))
})


dat <- data_frame(g = c("B","A","A"))
p <- ggplot(dat, aes(g, fill = g)) + geom_bar()
col <- c("A" = "red", "B" = "green", "C" = "blue")

cols <- function(x) ggplot_build(x)$data[[1]][, "fill"]

test_that("named values work regardless of order", {
  fill_scale <- function(order) scale_fill_manual(values = col[order],
    na.value = "black")

  # Order of value vector shouldn't matter
  expect_equal(cols(p + fill_scale(1:3)), c("red", "green"))
  expect_equal(cols(p + fill_scale(1:2)), c("red", "green"))
  expect_equal(cols(p + fill_scale(2:1)), c("red", "green"))
  expect_equal(cols(p + fill_scale(c(3, 2, 1))), c("red", "green"))
  expect_equal(cols(p + fill_scale(c(3, 1, 2))), c("red", "green"))
  expect_equal(cols(p + fill_scale(c(1, 3, 2))), c("red", "green"))
})

test_that("missing values are replaced with na.value", {
  df <- data_frame(x = 1, y = 1:3, z = factor(c(1:2, NA), exclude = NULL))
  p <- ggplot(df, aes(x, y, colour = z)) +
    geom_point() +
    scale_colour_manual(values = c("black", "black"), na.value = "red")

  expect_equal(layer_data(p)$colour, c("black", "black", "red"))
})

test_that("insufficient values raise an error", {
  df <- data_frame(x = 1, y = 1:3, z = factor(c(1:2, NA), exclude = NULL))
  p <- qplot(x, y, data = df, colour = z)

  expect_error(ggplot_build(p + scale_colour_manual(values = "black")),
    "Insufficient values")

  # Should be sufficient
  ggplot_build(p + scale_colour_manual(values = c("black", "black")))
})

test_that("values are matched when scale contains more unique values than are in the data", {
  s <- scale_colour_manual(values = c("8" = "c", "4" = "a",
    "22" = "d", "6"  = "b"))
  s$train(c("4", "6", "8"))
  expect_equal(s$map(c("4", "6", "8")), c("a", "b", "c"))
})

test_that("generic scale can be used in place of aesthetic-specific scales", {
  df <- data_frame(x = letters[1:3], y = LETTERS[1:3], z = factor(c(1, 2, 3)))
  p1 <- ggplot(df, aes(z, z, shape = x, color = y, alpha = z)) +
    scale_shape_manual(values = 1:3) +
    scale_colour_manual(values = c("red", "green", "blue")) +
    scale_alpha_manual(values = c(0.2, 0.4, 0.6))

  p2 <- ggplot(df, aes(z, z, shape = x, color = y, alpha = z)) +
    scale_discrete_manual(aesthetics = "shape", values = 1:3) +
    scale_discrete_manual(aesthetics = "colour", values = c("red", "green", "blue")) +
    scale_discrete_manual(aesthetics = "alpha", values = c(0.2, 0.4, 0.6))

  expect_equal(layer_data(p1), layer_data(p2))
})

test_that("named values do not match with breaks in manual scales", {
  s <- scale_fill_manual(
    values = c("data_red" = "red", "data_black" = "black"),
    breaks = c("data_black", "data_red")
  )
  s$train(c("data_black", "data_red"))
  expect_equal(s$map(c("data_red", "data_black")), c("red", "black"))
})

test_that("unnamed values match breaks in manual scales", {
  s <- scale_fill_manual(
    values = c("red", "black"),
    breaks = c("data_red", "data_black")
  )
  s$train(c("data_red", "data_black"))
  expect_equal(s$map(c("data_red", "data_black")), c("red", "black"))
})

test_that("limits works (#3262)", {
  # named charachter vector
  s1 <- scale_colour_manual(values = c("8" = "c", "4" = "a", "6" = "b"), limits = c("4", "8"))
  s1$train(c("4", "6", "8"))
  expect_equal(s1$map(c("4", "6", "8")), c("a", NA, "c"))

  # named charachter vector
  s2 <- scale_colour_manual(values = c("c", "a", "b"), limits = c("4", "8"))
  s2$train(c("4", "6", "8"))
  expect_equal(s2$map(c("4", "6", "8")), c("c", NA, "a"))
})