Skip to content

Commit 35ae74a

Browse files
committed
supply defaults for geo
1 parent b881917 commit 35ae74a

File tree

2 files changed

+43
-2
lines changed

2 files changed

+43
-2
lines changed

R/subplots.R

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -98,11 +98,20 @@ subplot <- function(..., nrows = 1, widths = NULL, heights = NULL, margin = 0.02
9898
x$annotations[!axes]
9999
})
100100
# collect axis objects (note a _single_ geo object counts a both an x and y)
101+
geoDomainDefault <- list(x = c(0, 1), y = c(0, 1))
101102
xAxes <- lapply(layouts, function(lay) {
102-
lay[grepl("^xaxis|^geo", names(lay))] %||% list(xaxis = list(domain = c(0, 1)))
103+
keys <- grep("^geo|^xaxis", names(lay), value = TRUE) %||% "xaxis"
104+
for (k in keys) {
105+
lay[[k]]$domain <- lay[[k]]$domain %||% if (grepl("^geo", k)) geoDomainDefault else c(0, 1)
106+
}
107+
lay[keys]
103108
})
104109
yAxes <- lapply(layouts, function(lay) {
105-
lay[grepl("^yaxis|^geo", names(lay))] %||% list(yaxis = list(domain = c(0, 1)))
110+
keys <- grep("^geo|^yaxis", names(lay), value = TRUE) %||% "yaxis"
111+
for (k in keys) {
112+
lay[[k]]$domain <- lay[[k]]$domain %||% if (grepl("^geo", k)) geoDomainDefault else c(0, 1)
113+
}
114+
lay[keys]
106115
})
107116
if (!titleX) {
108117
xAxes <- lapply(xAxes, function(ax) lapply(ax, function(y) { y$title <- NULL; y }))

tests/testthat/test-plotly-subplot.R

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -136,3 +136,35 @@ test_that("ggplotly understands ggmatrix", {
136136
L <- save_outputs(GGally::ggpairs(iris), "plotly-subplot-ggmatrix")
137137
})
138138

139+
test_that("geo+cartesian behaves", {
140+
# specify some map projection/options
141+
g <- list(
142+
scope = 'usa',
143+
projection = list(type = 'albers usa'),
144+
lakecolor = toRGB('white')
145+
)
146+
# create a map of population density
147+
density <- state.x77[, "Population"] / state.x77[, "Area"]
148+
map <- plot_ly(
149+
z = density,
150+
text = state.name, locations = state.abb,
151+
type = 'choropleth', locationmode = 'USA-states', geo = "geo"
152+
) %>% layout(geo = g)
153+
# create a bunch of horizontal bar charts
154+
vars <- colnames(state.x77)
155+
barcharts <- lapply(vars, function(var) {
156+
plot_ly(x = state.x77[, var], y = state.name, type = "bar",
157+
orientation = "h", name = var) %>%
158+
layout(showlegend = FALSE, hovermode = "y",
159+
yaxis = list(showticklabels = FALSE))
160+
})
161+
s <- subplot(
162+
subplot(barcharts, margin = 0.01), map,
163+
nrows = 2, heights = c(0.3, 0.7)
164+
)
165+
l <- expect_traces(s, 9, "geo-cartesian")
166+
geoDom <- l$layout[[grep("^geo", names(l$layout))]]$domain
167+
expect_equal(geoDom$x, c(0, 1))
168+
expect_equal(geoDom$y, c(0, 0.68))
169+
})
170+

0 commit comments

Comments
 (0)