Shiny Modules: Use SliderInput in multiple Elements-CodePudding

I am new to Shiny Modules, and I want to use the input from the sliderInput in (at least) two different elements. Therefore I created a little reprex. I want to have a histogram with a vertical line to display the slider value and a table in the main panel, which should be filtered based on the same slider value. Because in practice I have a lot of sliders, I thought Shiny Modules would be a good thing way to structure and reduce the amount of code.

Unfortunately, I have a bug, already tried various things but couldn't find a way how to resolve it. I cannot access the slider value in the table and the histogram. Thanks in advance for your help.

library(shiny)
library(tidyverse)

ui_slider <- function(id, height = 140, label = "My Label") {
  sliderInput(inputId = NS(id, "slider"), label = label, min = 0, max = 5, value = 1)
}

server_slider <- function(id) {
  moduleServer(id, function(input, output, session) {
    reactive(get(input$slider))
  })
}


ui_hist <- function(id, height = 140) {
  plotOutput(outputId = NS(id, "hist_plot"), height = height)
}

server_hist <- function(id, df, col, slider_value) {
  stopifnot(is.reactive(slider_value))
  
  moduleServer(id, function(input, output, session) {
    output$hist_plot <- renderPlot({
      df %>%
        ggplot(aes_string(x = col))  
        geom_histogram()  
        geom_vline(aes(xintercept = slider_value()))
    })
  })
}

ui <- fluidPage(
  titlePanel("My Dashboard"),
  sidebarLayout(
    sidebarPanel(
      ui_hist("gear"),
      ui_slider("gear", label = "Gear"),
      ui_hist("carb"),
      ui_slider("carb", label = "Carb")
    ),
    mainPanel(
      tableOutput("table")
    )
  )
)

server <- function(input, output, session) {
  gear_val <- server_slider("gear")
  carb_val <- server_slider("carb")
  
  server_hist(
    id = "gear",
    df = tibble(mtcars),
    col = "gear",
    slider_value = gear_val
  )
  
  server_hist(
    id = "carb",
    df = tibble(mtcars),
    col = "carb",
    slider_value = carb_val
  )
  
  output$table <- renderTable({
    tibble(mtcars) %>%
      filter(gear > gear_val()) %>%
      filter(carb > carb_val())
  })
}

# Run the application
shinyApp(ui = ui, server = server)

^{Created on 2022-04-22 by the reprex package (v2.0.1)}

CodePudding user response：

You're using get() unnecessarily in your slider module server function. Removing it should resolve the issue.

server_slider <- function(id) {
  moduleServer(id, function(input, output, session) {
    reactive(input$slider)
  })
}