Enable Action Button if Input has changed

user_216064 0
Viewed 411

My app should follow this logic: If an action button is pressed, all inputs are disabled and a long computation is performed. When the computation is finished and its results are plotted, all inputs except for the action button become enabled again. If the user decides to change one input, the action button becomes enabled.

Most of this desired behaviour is working, except for the last bit, the enabling of the action button. Here is my server function (the action button is named "go"):

server <- function(input, output, session) {
        allinputIds <- reactive(names(input))
                
        shiny::observeEvent(input$go, {
            for (id in allinputIds()) shinyjs::disable(id)  
        })
        
        # ==> here is some trouble: not working
        shiny::observeEvent(allinputIds(), shinyjs::enable("go"))
    
        # from here starts the real work
        bins <- shiny::eventReactive(input$go, {
            x <- faithful$waiting
            Sys.sleep(1.5)
            seq(min(x), max(x), length.out = input$bins + 1)
        })

        output$figure <- shiny::renderPlot({
            x <- faithful$waiting 
            hist(
                x, breaks = bins(), col = "#75AADB", border = "white",
                xlab = "Waiting time to next eruption (in mins)",
                main = "Histogram of waiting times"
            )
            for (id in setdiff(allinputIds(), "go")) shinyjs::enable(id)
        })
    }

How can I observe that any input has been changed? Instead of allinputIds() after the line marked "==>", I tried input but this worked neither.

As a second question, what would you recommend to encapsulate this button / disable / enable pattern, which I plan to use on more than one shiny module. It would be nice if I could concentrate on the main code, i.e. bins and output$figure <- ....

Any hint appreciated!

For reproducibility, here is the ui function:

ui <- shiny::tagList(
    shinyjs::useShinyjs(), 
    shiny::navbarPage(title="Test 2",
        tabPanel(title="Old Faithful",
        shiny::sidebarLayout(
            shiny::sidebarPanel(
                    shiny::sliderInput(
                        inputId = "bins",
                        label = "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30
                    )
                ),
                shiny::mainPanel(
                    shiny::actionButton("go", "Update"),
                    shinycssloaders::withSpinner(plotOutput(outputId="figure")),
                    shiny::h4(shiny::textOutput("msg"))
                )
            )
        )
    )
)

shiny::shinyApp(ui, server)
shinyjs shiny r
1 Answers

The problem is that in shiny::observeEvent(allinputIds(), shinyjs::enable("go")) you just check if the names/amount of input ids change - they don't. You actually need to check if the values of any of the inputs (besides the action button) has changed. Therefore you can either put all inputs directly into the observe like c(input$bins, input$...) or make an extra reactive to check for the values and just call this reactive.

library(shiny)

server <- function(input, output, session) {
  allinputIds <- reactive(names(input))
  
  changingInputValues <- reactive({
    checkIds <- setdiff(names(input), "go")
    lapply(checkIds, function(x) input[[x]])
  })
  
  observeEvent(input$go, {
    lapply(allinputIds(), shinyjs::disable)  
  })
  
  # ==> here is some trouble: not working
  observeEvent(changingInputValues(), shinyjs::enable("go"))
  
  # from here starts the real work
  bins <- eventReactive(input$go, {
    x <- faithful$waiting
    Sys.sleep(1.5)
    seq(min(x), max(x), length.out = input$bins + 1)
  })
  
  output$figure <- renderPlot({
    x <- faithful$waiting 
    hist(
      x, breaks = bins(), col = "#75AADB", border = "white",
      xlab = "Waiting time to next eruption (in mins)",
      main = "Histogram of waiting times"
    )
    
    lapply(setdiff(allinputIds(), "go"), shinyjs::enable)
  })
}

ui <- tagList(
  shinyjs::useShinyjs(), 
  navbarPage(title="Test 2",
                    tabPanel(title="Old Faithful",
                             sidebarLayout(
                               sidebarPanel(
                                 sliderInput(
                                   inputId = "bins",
                                   label = "Number of bins:",
                                   min = 1,
                                   max = 50,
                                   value = 30
                                 )
                               ),
                               mainPanel(
                                 actionButton("go", "Update"),
                                 shinycssloaders::withSpinner(plotOutput(outputId="figure")),
                                 h4(textOutput("msg"))
                               )
                             )
                    )
  )
)

shinyApp(ui, server)

Note that I've changed the for loops to lapply, as for loops tend to not work well with shiny (unfortunately, I'm not sure why). A few times the enabling of the inputs didn't work when using the loop, but with lapply I haven't had any problems.

user_126473150
Related