R Shiny Dashboard - uiOutput not rendering inside tab items

Question

I am building a shiny dashboard and want to include a slider bar with a dynamic range of values. To do this I am generating the sliderInput on the server and displaying it with renderUI / uiOuput . In the example below this works fine if I only include the slider on one tabPanel . However, when I attempt to add it to a second tabPanel it fails to render on either.

This post describes a similar problem but the solution ( suspendWhenHidden = FALSE ) does not work for me. I also tried the solution from this post although the issue there was somewhat different.

library(shinydashboard)
library(shiny)
ui <- dashboardPage(
  dashboardHeader(title = "Demo dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Overview", tabName = "overview", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "overview",
        fluidRow(
          column(width = 6,
            tabBox(
             title = "Tab box",
             width = "100%",
             id = "tabset1", height = "250px",
             tabPanel("Tab 1",
              img(src = "test_img.jpg", height="100%", width="100%", align="center"),
              # the slider is rendered properly if only included in a single tab
              uiOutput("out_slider")
             ),
             tabPanel("Tab 2",
              img(src = "test_img.jpg", height="100%", width="100%", align="center"),
              # however, uncommenting below causes the slider to not render on *either* tab 
              #uiOutput("out_slider")
             )
            )
          )
        )
      )
    )
  )
)


server <- function(input, output) {
  
  
  startDate <- as.Date("2019-01-01","%Y-%m-%d")
  endDate <- as.Date("2020-01-01","%Y-%m-%d")
  
  # from https://stackoverflow.com/q/36613018/11434833 ... does not seem to fix problem
  # output$out_slider <- renderUI({})
  # outputOptions(output, "out_slider", suspendWhenHidden = FALSE)
  
  output$out_slider <- renderUI({
    sliderInput("slider1", label = h3("Slider"), min = startDate, 
                max = endDate, value = endDate,timeFormat="%e %b, %y")
  })
  
}

shinyApp(ui, server)

Answer 1

As mentioned by YBS, there is a conflict in the ID. Try creating modules like shown below.

library(shinydashboard)
library(shiny)

slider<-function(id){
  ns<-NS(id)
  tagList(
    uiOutput(ns("out_slider"))
  )
}

sliderServer<-function(id, label, min, 
                      max , value, timeFormat="%e %b, %y"){
  moduleServer(
    id,
    function(input,output,session){
      output$out_slider <- renderUI({
        sliderInput("slider", label , min, 
                    max, value, timeFormat="%e %b, %y")
      })
    }
  )
}


ui <- dashboardPage(
  dashboardHeader(title = "Demo dashboard"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Overview", tabName = "overview", icon = icon("dashboard"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "overview",
              fluidRow(
                column(width = 6,
                       tabBox(
                         title = "Tab box",
                         width = "100%",
                         id = "tabset1", height = "250px",
                         tabPanel("Tab 1",
                                  img(src = "test_img.jpg", height="100%", width="100%", align="center"),
                                  # the slider is rendered properly if only included in a single tab
                                  slider("tab1")
                         ),
                         tabPanel("Tab 2",
                                  img(src = "test_img.jpg", height="100%", width="100%", align="center"),
                                  # however, uncommenting below causes the slider to not render on *either* tab 
                                  slider("tab2")
                         )
                       )
                )
              )
      )
    )
  )
)


server <- function(input, output) {
  
  
  startDate <- as.Date("2019-01-01","%Y-%m-%d")
  endDate <- as.Date("2020-01-01","%Y-%m-%d")
  
  sliderServer("tab1",label = h3("Slider"), min = as.Date("2019-01-01","%Y-%m-%d"), 
               max = as.Date("2020-01-01","%Y-%m-%d"), value = as.Date("2020-01-01","%Y-%m-%d"), timeFormat="%e %b, %y")
  
  sliderServer("tab2", label = h3("Slider"), min = as.Date("2019-01-01","%Y-%m-%d"), 
               max = as.Date("2020-01-01","%Y-%m-%d"), value = as.Date("2020-01-01","%Y-%m-%d"), timeFormat="%e %b, %y")
  

  
}

shinyApp(ui, server)

If you intend to pass reactive values in the sliderServer function, please wrap it in observeEvent.