@@ -90,3 +90,49 @@ test_that("Row/column height/width", {
90
90
expect_equal(diff(l $ layout $ yaxis2 $ domain ), 0.8 - 0.005 )
91
91
})
92
92
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