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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
test_that("range is expanded", {
df <- rbind(
data_frame(x = "a", y = c(0, runif(10), 1)),
data_frame(x = "b", y = c(0, runif(10), 2))
)
p <- ggplot(df, aes(1, y)) +
geom_violin(trim = FALSE) +
facet_grid(x ~ ., scales = "free") +
coord_cartesian(expand = FALSE)
expand_a <- stats::bw.nrd0(df$y[df$x == "a"]) * 3
expand_b <- stats::bw.nrd0(df$y[df$x == "b"]) * 3
expect_equal(layer_scales(p, 1)$y$dimension(), c(0 - expand_a, 1 + expand_a))
expect_equal(layer_scales(p, 2)$y$dimension(), c(0 - expand_b, 2 + expand_b))
})
test_that("geom_violin works in both directions", {
p <- ggplot(mpg) + geom_violin(aes(drv, hwy))
x <- layer_data(p)
expect_false(x$flipped_aes[1])
p <- ggplot(mpg) + geom_violin(aes(hwy, drv))
y <- layer_data(p)
expect_true(y$flipped_aes[1])
x$flipped_aes <- NULL
y$flipped_aes <- NULL
expect_identical(x, flip_data(y, TRUE)[,names(x)])
})
# create_quantile_segment_frame -------------------------------------------------
test_that("create_quantile_segment_frame functions for 3 quantiles", {
density.data <- data_frame(y = (1:256)/256, density = 1/256) # uniform density
qs <- c(0.25, 0.5, 0.75) # 3 quantiles
expect_equal(create_quantile_segment_frame(density.data, qs)$y,
rep(qs, each = 2))
})
test_that("quantiles do not fail on zero-range data", {
zero.range.data <- data_frame(y = rep(1,3))
p <- ggplot(zero.range.data) + geom_violin(aes(1, y), draw_quantiles = 0.5)
# This should return without error and have length one
expect_equal(length(layer_grob(p)), 1)
})
test_that("quantiles fails outside 0-1 bound", {
p <- ggplot(mtcars) +
geom_violin(aes(as.factor(gear), mpg), draw_quantiles = c(-1, 0.5))
expect_snapshot_error(ggplotGrob(p))
p <- ggplot(mtcars) +
geom_violin(aes(as.factor(gear), mpg), draw_quantiles = c(0.5, 2))
expect_snapshot_error(ggplotGrob(p))
})
test_that("quantiles are at expected positions at zero width", {
# Symmetric density with n components and zero middle:
# 50% quantile can be drawn anywhere as long as there is density 0
n <- 256
density <- c(rep(2, n / 4), rep(0, n / 2), rep(2, n / 4)) / n
density.data <- data_frame(y = (1:n) / n, density = density)
line <- create_quantile_segment_frame(density.data, 0.5)
y_idx <- which.min(abs(density.data$y - line$y[1]))
expect_equal(density[y_idx], 0)
})
test_that("quantiles do not issue warning", {
data <- data_frame(x = 1, y = c(0, 0.25, 0.5, 0.75, 5))
p <- ggplot(data, aes(x = x, y = y)) +
geom_violin(draw_quantiles = 0.5)
expect_warning(plot(p), regexp = NA)
})
# Visual tests ------------------------------------------------------------
test_that("geom_violin draws correctly", {
set.seed(111)
dat <- data_frame(x = rep(factor(LETTERS[1:3]), 30), y = rnorm(90))
dat <- dat[dat$x != "C" | c(T, F),] # Keep half the C's
expect_doppelganger("basic",
ggplot(dat, aes(x = x, y = y)) + geom_violin()
)
expect_doppelganger("scale area to sample size (C is smaller)",
ggplot(dat, aes(x = x, y = y)) + geom_violin(scale = "count"),
)
expect_doppelganger("narrower (width=.5)",
ggplot(dat, aes(x = x, y = y)) + geom_violin(width = .5)
)
expect_doppelganger("with tails and points",
ggplot(dat, aes(x = x, y = y)) + geom_violin(trim = FALSE) + geom_point(shape = 21)
)
expect_doppelganger("with smaller bandwidth and points",
ggplot(dat, aes(x = x, y = y)) + geom_violin(adjust = .3) + geom_point(shape = 21)
)
expect_doppelganger("dodging",
ggplot(dat, aes(x = "foo", y = y, fill = x)) + geom_violin()
)
expect_doppelganger("coord_polar",
ggplot(dat, aes(x = x, y = y)) + geom_violin() + coord_polar()
)
expect_doppelganger("coord_flip",
ggplot(dat, aes(x = x, y = y)) + geom_violin() + coord_flip()
)
expect_doppelganger("dodging and coord_flip",
ggplot(dat, aes(x = "foo", y = y, fill = x)) + geom_violin() + coord_flip()
)
expect_doppelganger("continuous x axis, many groups (center should be at 2.0)",
ggplot(dat, aes(x = as.numeric(x), y = y)) + geom_violin()
)
expect_doppelganger("continuous x axis, single group (center should be at 1.0)",
ggplot(dat, aes(x = as.numeric(1), y = y)) + geom_violin()
)
expect_doppelganger("quantiles",
ggplot(dat, aes(x=x, y=y)) + geom_violin(draw_quantiles=c(0.25,0.5,0.75))
)
dat2 <- data_frame(x = rep(factor(LETTERS[1:3]), 30), y = rnorm(90), g = rep(factor(letters[5:6]), 45))
expect_doppelganger("grouping on x and fill",
ggplot(dat2, aes(x = x, y = y, fill = g)) + geom_violin()
)
expect_doppelganger("grouping on x and fill, dodge width = 0.5",
ggplot(dat2, aes(x = x, y = y, fill = g)) +
geom_violin(position = position_dodge(width = .5))
)
})
|
