I want to build a shiny app in R which houses several stand alone applications. I use shinydashboard for this but the UI wont update propperly. In this example the UI does update when I go to program 3, but only for that tab. When I remove program 3 it will only work for program 2. It looks like the order of code has something to do with it, but I do not understand whats wrong.

library(shiny)
library(shinydashboard)

# Define the UI components
ui <- dashboardPage(
  dashboardHeader(title = "VBL Tooling", titleWidth = 400),
  
  # Sidebar
  dashboardSidebar(
    sidebarMenu(id = "sidebar",
                menuItem("Homepage", tabName = "home", icon = icon("home")),
                menuItem("Program1", tabName = "program1", icon = icon("cogs")),
                menuItem("Program2", tabName = "program2", icon = icon("cogs")),
                menuItem("Program3", tabName = "program3", icon = icon("cogs"))
    )
  ),
  
  # Body
  dashboardBody(
    tabItems(
      tabItem(tabName = "home",
              fluidPage(
                h2("Welcome to the Homepage"),
                fluidRow(
                  column(4, actionButton("program1_btn", "Go to Program 1")),
                  column(4, actionButton("program2_btn", "Go to Program 2")),
                  column(4, actionButton("program3_btn", "Go to Program 3"))
                )
              )
      ),
      
      tabItem(tabName = "program1", uiOutput("program_ui")),  # Dynamically render UI for Program 1
      tabItem(tabName = "program2", uiOutput("program_ui")),  # Dynamically render UI for Program 2
      tabItem(tabName = "program3", uiOutput("program_ui"))   # Dynamically render UI for Program 3
    )
  )
)

server <- function(input, output, session) {
  
  # Reactive value to store the UI content
  current_ui <- reactiveVal(NULL)
  
  # Define the UI components for each program
  program1_ui <- fluidPage(
    h3("Program 1 UI"),
    textInput("input1", "Enter something for Program 1:", ""),
    actionButton("submit1", "Submit")
  )
  
  program2_ui <- fluidPage(
    h3("Program 2 UI"),
    textInput("input2", "Enter something for Program 2:", ""),
    actionButton("submit2", "Submit")
  )
  
  program3_ui <- fluidPage(
    h3("Program 3 UI"),
    textInput("input3", "Enter something for Program 3:", ""),
    actionButton("submit3", "Submit")
  )
  
  # Observe button clicks and change tabs accordingly
  observeEvent(input$program1_btn, {
    current_ui(program1_ui)  # Set UI for Program 1
    updateTabItems(session, "sidebar", selected = "program1")  # Update sidebar
  })
  
  observeEvent(input$program2_btn, {
    current_ui(program2_ui)  # Set UI for Program 2
    updateTabItems(session, "sidebar", selected = "program2")  # Update sidebar
  })
  
  observeEvent(input$program3_btn, {
    current_ui(program3_ui)  # Set UI for Program 3
    updateTabItems(session, "sidebar", selected = "program3")  # Update sidebar
  })
  
  # Dynamically render the UI based on the button clicked
  output$program_ui <- renderUI({
    current_ui()  # Render the UI content stored in the reactive value
  })
}

shinyApp(ui, server)

I want to build a shiny app in R which houses several stand alone applications. I use shinydashboard for this but the UI wont update propperly. In this example the UI does update when I go to program 3, but only for that tab. When I remove program 3 it will only work for program 2. It looks like the order of code has something to do with it, but I do not understand whats wrong.

library(shiny)
library(shinydashboard)

# Define the UI components
ui <- dashboardPage(
  dashboardHeader(title = "VBL Tooling", titleWidth = 400),
  
  # Sidebar
  dashboardSidebar(
    sidebarMenu(id = "sidebar",
                menuItem("Homepage", tabName = "home", icon = icon("home")),
                menuItem("Program1", tabName = "program1", icon = icon("cogs")),
                menuItem("Program2", tabName = "program2", icon = icon("cogs")),
                menuItem("Program3", tabName = "program3", icon = icon("cogs"))
    )
  ),
  
  # Body
  dashboardBody(
    tabItems(
      tabItem(tabName = "home",
              fluidPage(
                h2("Welcome to the Homepage"),
                fluidRow(
                  column(4, actionButton("program1_btn", "Go to Program 1")),
                  column(4, actionButton("program2_btn", "Go to Program 2")),
                  column(4, actionButton("program3_btn", "Go to Program 3"))
                )
              )
      ),
      
      tabItem(tabName = "program1", uiOutput("program_ui")),  # Dynamically render UI for Program 1
      tabItem(tabName = "program2", uiOutput("program_ui")),  # Dynamically render UI for Program 2
      tabItem(tabName = "program3", uiOutput("program_ui"))   # Dynamically render UI for Program 3
    )
  )
)

server <- function(input, output, session) {
  
  # Reactive value to store the UI content
  current_ui <- reactiveVal(NULL)
  
  # Define the UI components for each program
  program1_ui <- fluidPage(
    h3("Program 1 UI"),
    textInput("input1", "Enter something for Program 1:", ""),
    actionButton("submit1", "Submit")
  )
  
  program2_ui <- fluidPage(
    h3("Program 2 UI"),
    textInput("input2", "Enter something for Program 2:", ""),
    actionButton("submit2", "Submit")
  )
  
  program3_ui <- fluidPage(
    h3("Program 3 UI"),
    textInput("input3", "Enter something for Program 3:", ""),
    actionButton("submit3", "Submit")
  )
  
  # Observe button clicks and change tabs accordingly
  observeEvent(input$program1_btn, {
    current_ui(program1_ui)  # Set UI for Program 1
    updateTabItems(session, "sidebar", selected = "program1")  # Update sidebar
  })
  
  observeEvent(input$program2_btn, {
    current_ui(program2_ui)  # Set UI for Program 2
    updateTabItems(session, "sidebar", selected = "program2")  # Update sidebar
  })
  
  observeEvent(input$program3_btn, {
    current_ui(program3_ui)  # Set UI for Program 3
    updateTabItems(session, "sidebar", selected = "program3")  # Update sidebar
  })
  
  # Dynamically render the UI based on the button clicked
  output$program_ui <- renderUI({
    current_ui()  # Render the UI content stored in the reactive value
  })
}

shinyApp(ui, server)

• r
• shiny

1 Answer 1

You need to provide unique inputId for each of the uiOuput() objects. I've made a few changes.

1. place program<i>_ui in a list (I called it pui)
2. create a small function to switch tabs
3. Use lapply over 1:3 to switch tabs, and render the ui

library(shiny)
library(shinydashboard)

# Define the UI components for each program
program1_ui <- fluidPage(
  h3("Program 1 UI"),
  textInput("input1", "Enter something for Program 1:", ""),
  actionButton("submit1", "Submit")
)

program2_ui <- fluidPage(
  h3("Program 2 UI"),
  textInput("input2", "Enter something for Program 2:", ""),
  actionButton("submit2", "Submit")
)

program3_ui <- fluidPage(
  h3("Program 3 UI"),
  textInput("input3", "Enter something for Program 3:", ""),
  actionButton("submit3", "Submit")
)
pui <- list(program1_ui, program2_ui, program3_ui)


# Define the UI components
ui <- dashboardPage(
  dashboardHeader(title = "VBL Tooling", titleWidth = 400),
  
  # Sidebar
  dashboardSidebar(
    sidebarMenu(id = "sidebar",
                menuItem("Homepage", tabName = "home", icon = icon("home")),
                menuItem("Program1", tabName = "program1", icon = icon("cogs")),
                menuItem("Program2", tabName = "program2", icon = icon("cogs")),
                menuItem("Program3", tabName = "program3", icon = icon("cogs"))
    )
  ),
  
  # Body
  dashboardBody(
    tabItems(
      tabItem(tabName = "home",
              fluidPage(
                h2("Welcome to the Homepage"),
                fluidRow(
                  column(4, actionButton("program1_btn", "Go to Program 1")),
                  column(4, actionButton("program2_btn", "Go to Program 2")),
                  column(4, actionButton("program3_btn", "Go to Program 3"))
                )
              )
      ),
      
      tabItem(tabName = "program1", uiOutput("program_ui1")),  # Dynamically render UI for Program 1
      tabItem(tabName = "program2", uiOutput("program_ui2")),  # Dynamically render UI for Program 2
      tabItem(tabName = "program3", uiOutput("program_ui3"))   # Dynamically render UI for Program 3
    )
  )
)

server <- function(input, output, session) {
  
  switch_tab <- function(i) {
    observeEvent(input[[paste0("program",i,"_btn")]], {
      updateTabItems(session, "sidebar", selected = paste0("program",i))  
    })
  }

  lapply(1:3, \(i) {
    switch_tab(i)
    output[[paste0("program_ui",i)]] <- renderUI(pui[[i]])
  })
  
}

shinyApp(ui, server)