Shinydashboard Box Collapse

[kalyan]

library(shinydashboard)
library(shiny)
library(dplyr)
 

trtall <- rbind(rep("A",100),rep("B",100), rep("C",100))
trt <- sample(trtall,80)
agecat.temp <- c(rep("18-40",100), rep("> 40", 100))
agecat <- sample(agecat.temp, 80)
sex <- sample(rbind(rep("M",100),rep("F",100)),80)
race <- sample(rbind(rep("Asian",50),rep("Hispanic",50),rep("Other",50)),80)

df <- data.frame(trt, agecat, sex, race)

 
body <- dashboardBody(
  fluidRow(box(width=12,collapsed=F, collapsible = T, title="Filters", solidHeader = T,status="primary",
               box(width=5, height="220px", status="primary",
                   fluidRow(column(6,uiOutput("uivr1")),
                            column(6,uiOutput("uivl1")))))))
 
ui <- dashboardPage(
  dashboardHeader(disable = T),
  dashboardSidebar(disable = T),
  body, skin = "green"
)

 server = function(input, output) {
  reacui1 <- reactiveVal()

   observeEvent(input$vr1,{
      reacui1(as.list(df %>% distinct(!!input$vr1) %>% arrange(!!input$vr1)))
  })

  output$uivr1 <- renderUI(varSelectInput(width = "200px", "vr1",NULL,df))
  output$uivl1 <- renderUI(selectInput("vl1",width="200px",multiple=T,NULL,choices=reacui1()))
  
}

shinyApp(ui,server)

Hi,

I am dynamically trying to create UI in shiny app. The logic works fine until I collapse the box in shiny dashboard.

I did following steps and got unexpected results.

1. I select 'trt' in " vr1 " and choose "A" from " vl1 ".
2. I collapsed the box.
3. Then un-collapsed the box.
4. I select 'agecat' in " vr1 " - now I still see various treatments (A,B,C) but not distinct age categories (18-40, >40) in " vl1 "

Can you please help.

[cnbrownlie]

Hi,

The choices argument of a selectInput can't be a reactive value, for this you'll need to use updateSelectInput(). I've put a copy of your server below with a few changes:

• I've made reacui1 a reactive expression rather than a reactive value, this means you don't need the observeEvent to update its value as it will update automatically
• The observeEvent now just updates vl1 with the relevant information using updateSelectInput
• I've added session as an argument to your server function (this is necessary for updateSelectInput)
• When vr1 is selected, vl1 is reset and the choices updated.

server = function(input, output, session) { # add session arg to server function
  
  reacui1 <- reactive({as.list(df %>% distinct(!!input$vr1) %>% arrange(!!input$vr1))})
  
  observeEvent(input$vr1,{
    updateSelectInput(session,
                      "vl1",
                      selected = NULL, # assuming you want to reset the selected value
                      choices = reacui1()) # set choices to reacui1
  })
  
  output$uivr1 <- renderUI(varSelectInput(width = "200px", "vr1",NULL,df))
  output$uivl1 <- renderUI(selectInput("vl1",width="200px",multiple=T,NULL,choices=reacui1()))
  
}

Hope that helps.