Increase plot size in shiny when using ggplot face

问题:

Is there a way to increase the plot window size in shiny dependent on the number of facets that are used in a ggplot figure - perhaps using a vertical scroll.

For example, using the example below, when the input is "A" there are three facets and the plots look good. When the option "B" is selected the number of plots increases but the plot window stays the same size resulting in plots that are too small.

Is there a strategy to keep all the panel heights the same, independent of input? Thanks.

library(ggplot2)
library(shiny)

mtcars$cyl = sample(letters[1:5], 32, TRUE)

 ui <- fluidPage(
         navbarPage(title="title",
           tabPanel("One", 
                    column(3, 
                           wellPanel( selectInput('name', 'NAME', c("A", "B")))),
                    column(9, plotOutput('plot1')))
   ))


server <- function(input, output) {

    X = reactive({input$name == "A"})

        output$plot1 <- renderPlot({

          if(X()){
             p1 = ggplot(mtcars, aes(mpg, wt)) + facet_grid( . ~ gear )
          }else{
            p1 = ggplot(mtcars, aes(mpg, wt)) + facet_grid( cyl  ~ gear )
          }
          return(p1)})
    }



shinyApp(ui, server)

回答1:

You can find a working example below :

library(ggplot2)
library(shiny)
library(tidyverse)


mtcars$cyl = sample(letters[1:5], 32, TRUE)

gg_facet_nrow<- function(p){
  p %>% ggplot2::ggplot_build()  %>%
  magrittr::extract2('layout')       %>%
  magrittr::extract2('panel_layout') %>%
  magrittr::extract2('ROW')          %>%
  unique()                           %>%
  length()
  }

ui <- fluidPage(
 navbarPage(title="title",
         tabPanel("One", 
                  column(3, 
                         wellPanel( selectInput('name', 'NAME', c("A", "B")))),
                  column(9, plotOutput('plot1')))
))


server <- function(input, output) {

 X <- reactive({input$name == "A"})

 p1 <- reactive({
  if(X()){
   p1 <- ggplot(mtcars, aes(mpg, wt)) + facet_grid( . ~ gear )
  }else{
   p1 <- ggplot(mtcars, aes(mpg, wt)) + facet_grid( cyl  ~ gear )
  } 
 return(p1)
 })

he <- reactive(gg_facet_nrow(p1()))

output$plot1 <- renderPlot({p1() }, height = function(){he()*300})
}

shinyApp(ui,server)

This answer was possible thanks to the following posts :

• Shiny : variable height of renderplot (height = function(){he()*300}))
• Extract number of rows from faceted ggplot (gg_facet_nrow()).

回答2:

If using facet_wrap rather than facet_grid, the gg_facet_nrow function provided by Aurelien callens should be modified to:

gg_facet_nrow <- function(p){
    num_panels <- length(unique(ggplot_build(p)$data[[1]]$PANEL)) # get number of panels
    num_rows <- wrap_dims(num_panels)[1] # get number of rows
}

If you've defined the number of columns, then the function can be written as follows:

gg_facet_nrow <- function(p){
    num_panels <- length(unique(ggplot_build(p)$data[[1]]$PANEL)) # get number of panels
    num_cols <- ggplot_build(p)$layout$facet$params$ncol # get number of columns set by user
    num_rows <- wrap_dims(num_panels, ncol=num_cols)[1] # determine number of rows
}

Besides changing to facet_wrap, other code provided in Aurelien callens answer remains the same.