2

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)
Nick
  • 162
  • 6

1 Answers1

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.

Asitav Sen
  • 56
  • 4
  • Thanks for the example of modules, Asitav. I'm unclear what doing it this way accomplishes, however, as opposed to simply duplicating the `output$out_slider <- renderUI({ ...` chunk of code from my original example (with a different output ID). In your example you still have to call `sliderServer` twice, with unique IDs ... so what did using modules accomplish? – Nick Feb 01 '21 at 20:44
  • Thanks Nick. That was my question too before I started using modules. Modules apparently do not add value in small applications. However consider this 1. What is inside `renderUI` you had, say 20 lines of code and 2. You need to use call this 10 times in your application In that case, using modules will reduce the amount of coding and effort. Moreover, you also avoid copy pasting, which is prone to error. Basically, helps in managing the complexity. Finally, if you save your modules as separate R scripts or in a package, you can use them in other applications as well. – Asitav Sen Feb 02 '21 at 05:56
  • Great, thanks for the explanations .... now to figure out how to get each slider to update to match when the other is changed ... simple to do normally with `updateSliderInput`, but can't get it to work when they are inside the tab items – Nick Feb 02 '21 at 06:11
  • You are welcome, Nick. Can you share the code please? I can have a look. BTW, if you want to use the exact same output, why not keep one slider which is outside the tabs. May be, in a new `fluidRow` inside the box or in the box footer or outside the box? – Asitav Sen Feb 02 '21 at 07:32
  • Thanks for being willing to help. I actually figured out the issue with getting the sliders to update each other. As you mentioned, it would be more ideal to use one slider. But I want it to be a part of the `tabBox`, and for some reason, I can't get the `uiOutput` to render if I place it outside of a `tabPanel`. Similar to my original issue, but this time it cannot be due to duplicate IDs as I am only using one. – Nick Feb 03 '21 at 22:14