Use `sliderInput` scale block repeatedly in different tabs-CodePudding

I would like to use a user input (defined in a sliderInput call) in multiple tabs.

Consider the following code from this example. I would like to display the scale defined between # [reuse] and # [/reuse] also in Tab 1, without having to copy the code (i.e. the scale that is now defined between # [reuse] and # [/reuse] should be displayed in multiple tabs but only defined once).

library(shiny)
ui <- fluidPage(
  titlePanel("Old Faithful Geyser Data"),      
  tabsetPanel(               
    tabPanel("Tab 1", h1("First tab") ),
    tabPanel("Tab2",
             sidebarLayout(                   
               # [reuse]
               sidebarPanel(width = 3, 
                            sliderInput("bins", "# bins:", min=1, max=50, value=30)),
               # [/reuse]                   
               mainPanel(plotOutput("distPlot"))
             )
    )
  )
)
server <- function(input, output) {      
  output$distPlot <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins   1)        
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}
shinyApp(ui = ui, server = server)

Does someone have pointers about how to best achieve this? Many thanks in advance!

CodePudding user response：

Modularized version of the above example:

library(shiny)

sidebarUI <- function(id, label = "# bins:") {
  ns <- NS(id)
  sidebarPanel(width = 3,
               sliderInput(
                 ns("bins"),
                 label,
                 min = 1,
                 max = 50,
                 value = 30
               ))
}

sidebarServer <- function(id) {
  moduleServer(id,
               function(input, output, session) {
                 input$bins
               })
}

ui <- fluidPage(titlePanel("Old Faithful Geyser Data"),
                tabsetPanel(
                  tabPanel("Tab 1", h1("First tab")),
                  tabPanel("Tab2",
                           sidebarLayout(
                             sidebarUI("slider_1", "1. bins:"),
                             mainPanel(plotOutput("distPlot"))
                           )),
                  tabPanel("Tab3",
                           sidebarLayout(
                             sidebarUI("slider_2", "2. bins:"),
                             mainPanel("Something useful")
                           ))
                ))

server <- function(input, output) {
  output$distPlot <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = sidebarServer("slider_1")   1)
    hist(x,
         breaks = bins,
         col = 'darkgray',
         border = 'white')
  })
}

shinyApp(ui = ui, server = server)

Edit

PS: personally I'd make the tabsetPanel a child of the mainPanel and use a single sliderInput in the sidebarPanel across all tabs. If you want to use different labels for the slider use updateSliderInput to update it depending on the selected tab:

library(shiny)

ui <- fluidPage(titlePanel("Old Faithful Geyser Data"),
                sidebarLayout(sidebarPanel(
                  width = 3,
                  sliderInput(
                    "bins",
                    "# bins:",
                    min = 1,
                    max = 50,
                    value = 30
                  )
                ),
                mainPanel(
                  tabsetPanel(id = "myTabsetPanel",
                              tabPanel(
                                "Tab 1", h1("First tab"), plotOutput("distPlot")
                              ),
                              tabPanel("Tab 2", h1("Second tab")))
                )))

server <- function(input, output, session) {
  observeEvent(input$myTabsetPanel, {
    updateSliderInput(
      session = session,
      inputId = "bins",
      label = paste("Slider", input$myTabsetPanel)
    )
  })
  
  output$distPlot <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins   1)
    hist(x,
         breaks = bins,
         col = 'darkgray',
         border = 'white')
  })
}

shinyApp(ui = ui, server = server)