按钮对 Shiny 应用程序中的 slideBar 输入的更改没有反应

Question

I am trying to let shiny do a calculation with the slide bar value after the user clicks on the action button. After the action button has been clicked, the app should then show a message. At the moment I've got the following code running, but after you click the Action Button for the first time, it will automatically re-execute when the reactive slide bars change. Does someone have a suggestion to make it so that the action button must be clicked every time the slide bar input changes?

shinyApp(
  ui = fluidPage(
    div(
      id = "form",
      sliderInput("popDensity", "What is the population density?", value=0, min=0, max=1500),
      
      actionButton("button", "Evaluate", style="color: #fff; background-color: #337ab7; border-color: #2e6da4")
      
    ),
    div(
      id = "sidebar",
      sidebarPanel(
                   uiOutput("calculation")   ) )
  ),
  
  server = function(input, output) {
    likelihood<-reactive({(1/500)*input$popDensity})
    
    observeEvent(input$button, {
      
      output$calculation<-renderUI({
        if (likelihood()>1) {
          a <- paste("<span style=color:red> be careful! </span>")
        }
          else if (likelihood()>.65){
            a <- paste("<span style=color:orange> be careful! </span>")
          }
        else if (likelihood()>.35){
          a <- paste("<span style=color:yellow> be careful! </span>")
        }
        else if (likelihood()>.10){
          a <- paste("<span style=color:blue> be careful! </span>")
        }
               else {
          a <- paste("<span style=color:green> be careful! </span>")
        }
        HTML(a)
        
      })
    })  
  }
)

Answer 1

If you want the UI to update only when the button is clicked, then likelihood doesn't need to be reactive. So you can write your server function as

  server = function(input, output) {
    observeEvent(input$button, {
      likelihood<-(1/500)*input$popDensity
      output$calculation<-renderUI({
        if (likelihood>1) {
          a <- paste("<span style=color:red> be careful! </span>")
        }
        else if (likelihood>.65){
          a <- paste("<span style=color:orange> be careful! </span>")
        }
        else if (likelihood>.35){
          a <- paste("<span style=color:yellow> be careful! </span>")
        }
        else if (likelihood>.10){
          a <- paste("<span style=color:blue> be careful! </span>")
        }
        else {
          a <- paste("<span style=color:green> be careful! </span>")
        }
        HTML(a)
      })
    })  
  }

and get the effect you want.

Alternatively, if likelihood needs to remain reactive for reasons you haven't explained, then you need to isolate it from its dependency on the slider and introduce a dependency on the button into the renderUI call. Both are easy to do.

You can isolate a widget from a dependency on an input using isolate :

likelihood<-reactive({(1/500)*isolate(input$popDensity)})

Introducing the dependency on the button is equally easy: just add a reference to input$button anywhere in the renderUI call. This is often done at the top of the call:

output$calculation<-renderUI({
  input$button
  <your existing code here>
})