Skip to content

Commit b881917

Browse files
committed
moar subplot tests
1 parent 88591f6 commit b881917

File tree

1 file changed

+46
-0
lines changed

1 file changed

+46
-0
lines changed

tests/testthat/test-plotly-subplot.R

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,3 +90,49 @@ test_that("Row/column height/width", {
9090
expect_equal(diff(l$layout$yaxis2$domain), 0.8 - 0.005)
9191
})
9292

93+
test_that("recursive subplots work", {
94+
p1 <- plot_ly(economics, x = date, y = unemploy)
95+
p2 <- plot_ly(economics, x = date, y = uempmed)
96+
s1 <- subplot(p1, p1, shareY = TRUE)
97+
s2 <- subplot(p2, p2, shareY = TRUE)
98+
s <- subplot(s1, s2, nrows = 2, shareX = TRUE)
99+
l <- expect_traces(s, 4, "recursive")
100+
xaxes <- l$layout[grepl("^xaxis", names(l$layout))]
101+
yaxes <- l$layout[grepl("^yaxis", names(l$layout))]
102+
expect_true(length(xaxes) == 2)
103+
expect_true(length(yaxes) == 2)
104+
# both x-axes are anchored on the same y-axis
105+
yanchor <- unique(unlist(lapply(xaxes, "[[", "anchor")))
106+
expect_true(length(yanchor) == 1)
107+
# both y-axes are anchored on the same x-axis
108+
xanchor <- unique(unlist(lapply(yaxes, "[[", "anchor")))
109+
expect_true(length(xanchor) == 1)
110+
# x/y are anchored on the bottom/left
111+
expect_true(l$layout[[sub("x", "xaxis", xanchor)]]$domain[1] == 0)
112+
expect_true(l$layout[[sub("y", "yaxis", yanchor)]]$domain[1] == 0)
113+
# every trace is anchored on a different x/y axis pair
114+
xTraceAnchors <- sapply(l$data, "[[", "xaxis")
115+
yTraceAnchors <- sapply(l$data, "[[", "yaxis")
116+
expect_true(length(unique(paste(xTraceAnchors, yTraceAnchors))) == 4)
117+
})
118+
119+
test_that("subplot accepts a list of plots", {
120+
vars <- setdiff(names(economics), "date")
121+
plots <- lapply(vars, function(var) {
122+
plot_ly(x = economics$date, y = economics[[var]], name = var)
123+
})
124+
s <- subplot(plots, nrows = length(plots), shareX = TRUE, titleX = FALSE)
125+
l <- expect_traces(s, 5, "plot-list")
126+
xaxes <- l$layout[grepl("^xaxis", names(l$layout))]
127+
yaxes <- l$layout[grepl("^yaxis", names(l$layout))]
128+
expect_true(length(xaxes) == 1)
129+
expect_true(length(yaxes) == 5)
130+
# x-axis is anchored at the bottom
131+
expect_true(l$layout[[sub("y", "yaxis", xaxes[[1]]$anchor)]]$domain[1] == 0)
132+
})
133+
134+
135+
test_that("ggplotly understands ggmatrix", {
136+
L <- save_outputs(GGally::ggpairs(iris), "plotly-subplot-ggmatrix")
137+
})
138+

0 commit comments

Comments
 (0)