forked from animint/animint2
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathtest-renderer1-facet-space.R
180 lines (164 loc) · 7.19 KB
/
test-renderer1-facet-space.R
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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
acontext('a_facet_grid(space="free")')
no.panels <- a_plot(mtcars, a_aes(mpg, wt)) +
a_geom_point(colour='grey50', size = 4) +
a_geom_point(a_aes(colour = cyl))
viz <-
list(freeBoth = no.panels +
a_facet_grid(.~am, space = "free", scales = "free", labeller=a_label_both),
freeScale = no.panels +
a_facet_grid(.~am, scales="free", labeller=a_label_both),
fixed = no.panels +
a_facet_grid(.~am, labeller=a_label_both))
info <- animint2HTML(viz)
## For some reason the "space between panels" tests only work on
## travis/wercker if the rect class is "background_rect". Not
## "border_rect"! Even though they both should appear, only
## background_rect appears on travis/wercker... is this because we
## don't wait long enough before calling getHTML()?
panel.rect.xpath.tmp <- '//svg[@id="plot_%s"]//rect[@class="background_rect"]'
test_that("some horizontal space between panels", {
for(plot.name in names(viz)){
xpath <- sprintf(panel.rect.xpath.tmp, plot.name)
rect.list <- getNodeSet(info$html, xpath)
expect_equal(length(rect.list), 2)
first <- xmlAttrs(rect.list[[1]])
first.left <- as.numeric(first[["x"]])
first.right <- first.left+as.numeric(first[["width"]])
second <- xmlAttrs(rect.list[[2]])
second.left <- as.numeric(second[["x"]])
second.right <- second.left+as.numeric(second[["width"]])
expect_less_than(first.right, second.left)
## Also make sure the xtitle is placed in the middle of the
## plotting region.
xpath <- sprintf('//svg[@id="plot_%s"]//text[@class="xtitle"]', plot.name)
text.list <- getNodeSet(info$html, xpath)
expect_equal(length(text.list), 1)
transform.str <- xmlAttrs(text.list[[1]])[["transform"]]
transform.mat <- str_match_perl(transform.str, translatePattern)
xtitle.x.computed <- as.numeric(transform.mat[, "x"])
xtitle.x.expected <- (first.left + second.right)/2
expect_equal(xtitle.x.computed, xtitle.x.expected)
}
})
test_that("each plot has two x axes and 1 y axis", {
for(plot.name in names(viz)){
svg.xpath <- sprintf("//svg[@id='plot_%s']", plot.name)
x.xpath <- paste0(svg.xpath, "//g[contains(@class, 'xaxis')]")
x.axes <- getNodeSet(info$html, x.xpath)
y.xpath <- paste0(svg.xpath, "//g[contains(@class, 'yaxis')]")
y.axes <- getNodeSet(info$html, y.xpath)
expect_equal(length(y.axes), 1)
}
})
test_that("top strips present in each plot", {
for(plot.name in names(viz)){
xpath <- sprintf(
"//svg[@id='plot_%s']//g[@class='topStrip']//text", plot.name)
strip.text <- getNodeSet(info$html, xpath)
expect_equal(length(strip.text), 2)
text.values <- sapply(strip.text, xmlValue)
expect_identical(text.values, c("am: 0", "am: 1"))
}
})
test_that("pixels between 15 and 20 is constant or variable", {
## scale="fixed" means the distance between ticks 15 and 20 should
## be the same across the 2 panels.
x.axes <- getNodeSet(
info$html, "//svg[@id='plot_fixed']//g[contains(@class, 'xaxis')]")
expect_equal(length(x.axes), 2)
xdiff <- lapply(x.axes, getTickDiff)
expect_true(both.equal(xdiff))
## scale="free" means the distance between ticks 15 and 20 should
## be different across the 2 panels.
x.axes <- getNodeSet(
info$html, "//svg[@id='plot_freeScale']//g[contains(@class, 'xaxis')]")
expect_equal(length(x.axes), 2)
xdiff <- lapply(x.axes, getTickDiff)
expect_true(!both.equal(xdiff))
## scale="free" and space="free" means the distance between ticks 15
## and 20 should be the same across the 2 panels.
x.axes <- getNodeSet(
info$html, "//svg[@id='plot_freeBoth']//g[contains(@class, 'xaxis')]")
expect_equal(length(x.axes), 2)
xdiff <- lapply(x.axes, getTickDiff)
expect_true(both.equal(xdiff))
})
test_that("width_proportion is constant or variable", {
expect_true(both.equal(info$plots$fixed$layout$width_proportion))
expect_true(both.equal(info$plots$freeScale$layout$width_proportion))
expect_true(!both.equal(info$plots$freeBoth$layout$width_proportion))
})
no.panels <- a_plot(mtcars, a_aes(wt, mpg)) +
a_geom_point(colour='grey50', size = 4) +
a_geom_point(a_aes(colour = cyl))
viz <-
list(freeBoth = no.panels +
a_facet_grid(am ~ ., space = "free", scales = "free",
labeller=a_label_both),
freeScale = no.panels +
a_facet_grid(am ~ ., scales="free", labeller=a_label_both),
fixed = no.panels +
a_facet_grid(am ~ ., labeller=a_label_both))
info <- animint2HTML(viz)
test_that("some vertical space between panels", {
for(plot.name in names(viz)){
xpath <- sprintf(panel.rect.xpath.tmp, plot.name)
rect.list <- getNodeSet(info$html, xpath)
expect_equal(length(rect.list), 2)
first <- xmlAttrs(rect.list[[1]])
first.top <- as.numeric(first[["y"]])
first.bottom <- first.top+as.numeric(first[["height"]])
second <- xmlAttrs(rect.list[[2]])
second.top <- as.numeric(second[["y"]])
second.bottom <- second.top+as.numeric(second[["height"]])
expect_less_than(first.bottom, second.top)
## Also check that ytitle is placed in the middle of the plotting
## region.
xpath <- sprintf('//svg[@id="plot_%s"]//text[@class="ytitle"]', plot.name)
text.list <- getNodeSet(info$html, xpath)
expect_equal(length(text.list), 1)
transform.str <- xmlAttrs(text.list[[1]])[["transform"]]
transform.mat <- str_match_perl(transform.str, translatePattern)
ytitle.y.computed <- as.numeric(transform.mat[, "y"])
ytitle.y.expected <- (first.top + second.bottom)/2
expect_equal(ytitle.y.computed, ytitle.y.expected)
}
})
test_that("right strips present in each plot", {
for(plot.name in names(viz)){
xpath <- sprintf(
"//svg[@id='plot_%s']//g[@class='rightStrip']//text", plot.name)
strip.text <- getNodeSet(info$html, xpath)
expect_equal(length(strip.text), 2)
text.values <- sapply(strip.text, xmlValue)
expect_identical(text.values, c("am: 0", "am: 1"))
}
})
test_that("y pixels between 15 and 20 is constant or variable", {
## scale="fixed" means the distance between ticks 15 and 20 should
## be the same across the 2 panels.
y.axes <- getNodeSet(
info$html, "//svg[@id='plot_fixed']//g[contains(@class, 'yaxis')]")
expect_equal(length(y.axes), 2)
ydiff <- lapply(y.axes, getTickDiff, axis="y")
expect_true(both.equal(ydiff))
## scale="free" means the distance between ticks 15 and 20 should
## be different across the 2 panels.
y.axes <- getNodeSet(
info$html, "//svg[@id='plot_freeScale']//g[contains(@class, 'yaxis')]")
expect_equal(length(y.axes), 2)
ydiff <- lapply(y.axes, getTickDiff, axis="y")
expect_true(!both.equal(ydiff))
## scale="free" and space="free" means the distance between ticks 15
## and 20 should be the same across the 2 panels.
y.axes <- getNodeSet(
info$html, "//svg[@id='plot_freeBoth']//g[contains(@class, 'yaxis')]")
expect_equal(length(y.axes), 2)
ydiff <- lapply(y.axes, getTickDiff, axis="y")
expect_true(both.equal(ydiff))
})
test_that("height_proportion is constant or variable", {
expect_true(both.equal(info$plots$fixed$layout$height_proportion))
expect_true(both.equal(info$plots$freeScale$layout$height_proportion))
expect_true(!both.equal(info$plots$freeBoth$layout$height_proportion))
})