Arranging plotly subplots nicely in shiny - r

Question

I need to create a plotly plot in shiny that consists of subplots, which will be dynamically created with a changing number of rows (but only ever 2 plots per row). I would like each subplot to be the same size, and to have some space between all the subplots so that nothing overlaps, and to have the legend centred above the entire plot.
However, when more rows of subplots are added, the spacing between the legend and the subplots and between the rows of subplots, goes out of whack. It looks worse the more rows I add. Is there some trick to make subplots look nice and standardised in shiny, when the number of rows is dynamic?
I've inserted an example shiny app below, where you can change the number of rows, subplot margins, and vertical positioning of the legend. This is the basic formatting of what my plot will be - does anyone have any suggestions as to how to fix and standardise how the subplots and legend are arranged?
library(shiny)
library(plotly)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 2,
numericInput(inputId = "left", label = "left", value = 0.05, min = 0),
numericInput(inputId = "right", label = "right", value = 0.05, min = 0),
numericInput(inputId = "top", label = "top", value = 0.05, min = 0),
numericInput(inputId = "bottom", label = "bottom", value = 0.05, min = 0),
numericInput(inputId = "legend", label = "legend", value = 1.2, min = 0),
numericInput(inputId = "rows", label = "rows", value = 1, min = 1)
),
mainPanel(
width = 10,
plotlyOutput("plot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$plot <- renderPlotly({
rows <- input$rows
plot <- plot_ly(height = 400*rows)
plot <- add_trace(plot, data = economics, x = ~date, y = ~uempmed)
plot <- layout(
plot,
annotations = list(text = HTML("<b>title</b>"), showarrow = FALSE,
xref = 'x', x = 0.5, yref ='paper', y = 1.1),
legend = list(orientation = "h",
xanchor = "center", x = 0.5,
yanchor = "center", y = input$legend)
)
plots <- c()
for (x in 1:(rows*2)) {
plots[[x]] <- plot
}
subplot(plots, nrows = rows, shareY = FALSE, shareX = FALSE, titleY = TRUE, titleX = FALSE,
margin = c(input$left, input$right, input$top, input$bottom))
})
}
# Run the application
shinyApp(ui = ui, server = server)

Answer 1

One way to address your issue is to define the legend position, heights and margins to be dependent on the number of rows. Try this
server <- function(input, output) {
output$plot <- renderPlotly({
rows <- input$rows
mylegend <- 1 + 1/(5*rows)
myht <- c()
if (rows==1) {
myht <- c(1)
rowsd <- 1
}else {
rowsd <- rows-1
myht <- 1/rows
for (i in 2:rows) {
myht <- c(myht,1/rows)
if (i >3) rowsd <- rows - 1 - (i/3)
}
}
plot <- plot_ly(height = 400*rows)
plot <- add_trace(plot, data = economics, x = ~date, y = ~uempmed)
plot <- layout(
plot,
annotations = list(text = HTML("<b>title</b>"), showarrow = FALSE,
xref = 'x', x = 0.5, yref ='paper', y = 1.1),
legend = list(orientation = "h",
xanchor = "center", x = 0.5,
yanchor = "center", y = mylegend) # input$legend)
)
plots <- c()
for (x in 1:(rows*2)) {
plots[[x]] <- plot
}
subplot(plots, nrows = rows, shareY = FALSE, shareX = FALSE, titleY = TRUE, titleX = FALSE, # heights=myht,
margin = c(input$left, input$right, input$top/rowsd, input$bottom/rowsd)
)
})
}