Search code examples
rshinyshinyjs

Enable Action Button if Input has changed


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)

Solution

  • 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.