Shiny：为什么 updateSliderInput 只能工作一次？

Question

我正在尝试编写一个闪亮的应用程序，一旦我在按下按钮时执行任意代码，它就会动态地update slider input 最大值：

library(shiny)

ui <- fluidPage(

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30),
            actionButton(inputId ="refresh", label = 'boom')
        ),

        # Show a plot of the generated distribution
        mainPanel(
           plotOutput("distPlot")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {
    
    counter <- reactiveValues(c = nrow(faithful))

    observeEvent(input$refresh, {
        
        faithful <- faithful[-1:-10, ]
        counter$c <- nrow(faithful)
        updateSliderInput(session, "bins", min = 1, max = counter$c, value = counter/2)
    })
    
    
    output$distPlot <- renderPlot({
        # generate bins based on input$bins from ui.R
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = input$bins + 1)

        # draw the histogram with the specified number of bins
        hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })
}

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

不幸的是，滑块输入更新只能工作一次！文档示例建议使用 observe() 构造观察一些反应值，但是我希望在使用 observeEvent() 时，这样的功能也应该起作用。这里可能有什么问题？

感谢您的帮助！

Answer 1

这里的问题不是updateSliderInput，而是counter 不是反应式的，所以它在应用程序内部不是持久的。只需将其转换为本示例中的反应式，它就可以正常工作。

library(shiny)

ui <- fluidPage(
  
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),
      actionButton(inputId ="refresh", label = 'boom')
    ),
    
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {
  
  counter <- reactiveValues(c = 10)
  
  observeEvent(input$refresh, {
    counter$c <- counter$c + 10
    updateSliderInput(session, "bins", min = 1, max = counter$c, value = counter$c/2)
  })
  
  
  output$distPlot <- renderPlot({
    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    
    # draw the histogram with the specified number of bins
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}

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