Keep panel height the same as number of plot panels changes

I tried with the below to execute my following requirement. It is working perfectly but there is some issues

  1. The moment I click on Plot (Under Factor under datasets), the graphs should be displayed (It is working)

  2. After the above plot, if I click on filters (under Filter) the single graph is displayed accordingly. lets say when we select "dfg" the single graph is displayed capturing the entire screen. this should not happen. I need it to be displaced with reasonable grid size

     df <- structure(list(A = structure(c(1L, 4L, 6L, 1L, 8L, 2L, 7L, 3L, 
    5L, 5L, 1L, 8L, 2L, 7L, 2L), .Label = c("asd", "dfg", "fgdsgd", 
    "fsd", "gdfgd", "gs", "sdfg", "sf"), class = "factor"), B = c(29L, 
    24L, 46L, 50L, 43L, 29L, 32L, 24L, 35L, 39L, 33L, 47L, 53L, 26L, 
    31L), C = structure(c(8L, 5L, 1L, 6L, 3L, 2L, 9L, 7L, 6L, 3L, 
    2L, 9L, 8L, 8L, 4L), .Label = c("asd", "er", "fg", "gf", "gfd", 
    "gfg", "qw", "sf", "tr"), class = "factor"), D = c(36L, 56L, 
    39L, 26L, 56L, 35L, 27L, 31L, 33L, 45L, 34L, 27L, 43L, 40L, 56L
    ), E = structure(c(9L, 4L, 3L, 4L, 2L, 7L, 10L, 8L, 6L, 2L, 1L, 
    10L, 9L, 9L, 5L), .Label = c("er", "fg", "g", "gd", "gf", "gfg", 
    "gtd", "qw", "sf", "tr"), class = "factor"), F = c(44L, 34L,  
    37L, 23L, 37L, 51L, 28L, 36L, 33L, 31L, 39L, 43L, 25L, 37L, 43L
    ), num = 1:15), row.names = c(NA, -15L), class = "data.frame")
    
      theNames <- names(df)
     MyList  <- vector(mode = "list")
     for(i in theNames){
     MyList[[i]] <- df[,i]
     }
     library(ggplot2)
     library(dplyr)
     library(shiny)
    
     ui <- fluidPage(
    tabsetPanel(tabPanel(
    "Factor_Bivariate_Analysis",
    sidebarLayout(sidebarPanel(
    fluidRow(
      column(h6(
       selectInput("se4", "Factors under the
                   datasets", choices = c("", "Values"))
       ), width = 5, offset =
         0),
     br(),
     column(h6(
       actionButton("Val", "See the Values", width =
                      200, offset =
                      -1)
     ), width = 5, offset = 0),
     br(),
     column(h6(selectInput(
       "state", "Filters", choices = c("",MyList)
     )), width = 5, offset = 0)
     ), width =
     1000
      ),
     mainPanel(
     h5(plotOutput(
       "Plot4", width = "1000px", height =
         "1000px"
     ), width = 1000), h5(dataTableOutput("Plot5"), width = 1000)
     ))
     )))
    
    
      server <- function(input, output, session) {
      f_data <- reactive({
      wanted_case <- input$state
      cat("selected case ", wanted_case, "\n\n")
      if (wanted_case == ""){
      fd <- df
      } else {
      fd <- df %>% filter_if(.predicate = is.factor,.vars_predicate = any_vars (. == 
    wanted_case))
     print(fd)
     }
     return(fd)
     }) 
     Plot4 <- reactive({
     if (input$se4 == "Values") {
     print(ggplot(data = 
     f_data(),aes(x=num,y=B,fill=A))+geom_line()+facet_wrap("A",ncol=1,nrow=8, scales = 
     "free"))
     } else if (input$se4 == "NULL") {
     ""
     }
     })
    output$Plot4 <- renderPlot({
    Plot4()
    })
    }
    
    shinyApp(ui, server)

Thanks for making a reprex! But there seems to be a lot more going on in your code than just the problem you describe. I'd recommend spending a bit more time refining your example so it's more clear what the problem is. For example, I doubt the custom css is necessary, and you could probably use a built in data frame like mtcars.

(It also looks like you're using h5() and h6() to style the output — this is bad practice because you're breaking the semantics of the page; you should only use heading tags for actual headings)

Thanks for the response. I understand your points. But my problem is not that. When you run this code. You get 2 filter options. One is "Factors under the datasets" and other is "Filters". Now when you select values under "Factors under the datasets", the plot is displayed with many graphs. This if fine for me. But when you select dfg under "Filters" there is a single plot getting displayed. This is also fine but the issue is if you look carefully the size of the single plot is huge now and it does not look good. This is my issue. However I do take your other points that you have mentioned. Hope you got my points

If you want my help, you need to make a minimal reprex that illustrates only your problem and nothing else.

Hi I have edited my question, Please review

Your example is still not reproducible if I run your code I get this error

I know how to fix this but that is not the point, have in mind that you are asking people to spend their time solving your problems so the least you can do is to make it as easy as possible by providing a proper reprex.

when I run the code, I get the below plot. Can you please check again?

You have run the code in your computer not the code you have posted, it is impossible to get that result with the code in your post. Could you check again?

I checked again. For cross checking, I copied a same code in my post and altered the title just to check if this is correct code or not. But I am getting the plot. Not sure why you are not getting :frowning: :frowning: Are you really sure this code is not working?

Have you tried on a fresh R session?, you are getting the plot because the df object already exist in your environment, but in the code you have posted (which anyone else would run on a different session than yours) you haven't defined it.

Got it. Your right? I am very sorry for that. I did not notice that . I have corrected
my question for you

This is a paradox, you can't manipulate an object before it actually exist
Please put a little more effort on making a good reprex, that would attract more attention towards your problem and increase your chances of getting help. You have already lost the opportunity of getting help from one of the most influential people in the R community (Hadley) for not having a proper reprex.

1 Like

I am trying my best to give a proper reprex. Will try to improve on it. Apologies again. I have re-edited my question. Could you please review it?

To give you a hand with the reprex part, this would be a simplified version of your app that shows your issue, that if I understand it correctly is the size of your plot when the filter is applied. (I'm not giving you a solution because I have never used html tags for sizing my plots so I don't know how to do it).

library(ggplot2)
library(dplyr)
library(shiny)

df <- data.frame(A = as.factor(c("asd", "fsd", "gs", "asd", "sf", "dfg", "sdfg",
                                 "fgdsgd", "gdfgd", "gdfgd", "asd", "sf", "dfg",
                                 "sdfg", "dfg")),
                 B = c(29L, 24L, 46L, 50L, 43L, 29L, 32L, 24L, 35L, 39L, 33L, 47L, 53L, 26L, 31L),
                 C = as.factor(c("sf", "gfd", "asd", "gfg", "fg", "er", "tr", "qw",
                                 "gfg", "fg", "er", "tr", "sf", "sf", "gf")),
                 D = c(36L, 56L, 39L, 26L, 56L, 35L, 27L, 31L, 33L, 45L, 34L, 27L, 43L, 40L, 56L),
                 E = as.factor(c("sf", "gd", "g", "gd", "fg", "gtd", "tr", "qw",
                                 "gfg", "fg", "er", "tr", "sf", "sf", "gf")),
                 F = c(44L, 34L, 37L, 23L, 37L, 51L, 28L, 36L, 33L, 31L, 39L, 43L, 25L, 37L, 43L),
                 num = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L))

MyList <- vector(mode = "list")
for (i in names(df)) {
  MyList[[i]] <- df[, i]
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      fluidRow(column(h6(selectInput("state", "Filters", choices = c("", MyList))), width = 5, offset = 0)),
      width = 1000
    ),
    mainPanel(
      h5(plotOutput("Plot", width = "1000px", height = "1000px"), width = 1000)
    )
  )
)

server <- function(input, output, session) {
  f_data <- reactive({
    if (input$state == "") {
      df
    } else {
      df %>%
        filter_if(
          .predicate = is.factor,
          .vars_predicate = any_vars(. == input$state)
        )
    }
  })

  output$Plot <- renderPlot({
    f_data() %>%
      ggplot(aes(x = num, y = B, fill = A)) +
      geom_line() +
      facet_wrap("A", ncol = 1, nrow = 8, scales = "free")
  })
}

shinyApp(ui, server)

Here's an even simpler reprex using a built-in dataset, an eliminating a lot of the UI that seemed unrelated.

library(ggplot2)
library(shiny)

ui <- fluidPage(
  selectInput("cyl", "cyl", choices = c("", 4, 6, 8)),
  plotOutput("Plot", width = "1000px", height = "1000px")
)

server <- function(input, output, session) {
  f_data <- reactive({
    if (input$cyl == "") {
      mtcars
    } else {
      mtcars[mtcars$cyl == input$cyl, ]
    }
  })

  output$Plot <- renderPlot({
    f_data() %>%
      ggplot(aes(mpg, disp)) +
      geom_line() +
      facet_wrap(~ cyl , ncol = 1)
  })
}

shinyApp(ui, server)

Does it still illustrate the problem?

Hi Hadley thanks a lot for taking time to help me. But unfortunately this is not what I was looking for. All is good. But as soon as you apply filter (say 4) the single graph/plot is taking lot of space like below

Instead what i need is . Similary for other filters as well. Hope you got my points :slight_smile:

Are you trying to say that you want to change the height of the plot?

1 Like

Kind off. But the size of the plot should be interactive. Once you open the app there are 3 graphs right like below. That is perfect


But when i Select the filters (Say 4), I should get below plot

I should not get below plot

In both cases you have a single plot, but in the first case it has three panels and in the second case it has one panel. If you want to preserve the aspect ratio of the plot, you'll need to adjust the height of the plot to be proportion to the number panels that you're displaying (i.e. the number of unique values of the variable that you're faceting by). You can see the basic approach in Error in eval: object 'variable' not found (data table feeding plot in Shiny app).

1 Like

I tried with the code putting the code prescribed you but still not working

    library(ggplot2)
    library(shiny)

    ui <- fluidPage(
    selectInput("cyl", "cyl", choices = c("", 4, 6, 8)),
   plotOutput("Plot", width = "1000px", height = "1000px")
   ) 

   server <- function(input, output, session) {
  f_data <- reactive({
   if (input$cyl == "") {
   mtcars
  }  else {
  mtcars[mtcars$cyl == input$cyl, ]
  }
 })

 output$Plot <- renderPlot({
f_data() %>%
  ggplot(aes(mpg, disp)) +
  geom_line() +
  facet_wrap(~ cyl , ncol = 1)
  },height = function()length(input$cyl))
 }

 shinyApp(ui, server)