R Shiny Dashboard - uiOutput not rendering inside tab items - r

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.