Search code examples
rshinyshinyalert

How to break a for loop basing on captured shinyalert input value


I am using a for loop to create multiple popping up messages in my shiny app (using shinyalert package). I would like messages to stop popping if user had clicked Cancel as an answer to a previous message. Below a sample of code illustrating my example

library(shiny)
library(shinyalert)

ui <- fluidPage(
    actionButton("run", "Run")
)

server <- function(input, output, session) {

observeEvent(input$run, {
    
    vector.elements <- c("A", "B", "C", "D", "E")
    decision <<- TRUE
    
    for (element in vector) {
    
    shinyalert(
        title = "Do you accept following element?",
        text = element,
        showCancelButton =  TRUE,
        callbackR = mycallback)
        
        mycallback <- function(value) {
            decision <<- value
        }
        
        if (decision == FALSE) {
            break
        }
    }
})
}
shinyApp(ui = ui, server = server)

If user clicks on Cancel button as an answer to Do you accept following element? A, I would like next messages not to pop up.

Any hint would be much appreciated!


Solution

  • Shiny alert does not seem to be run synchronous to the loop. Put print(decision) in front of the for-loop. It'll show in the console that the loop runs independently from the user clicking on the alert messages. That means: it won't work with a for loop or any other loop. It can only be done using the event mechanisms provided by Shiny.

    The solution below creates and manipulates a reactive value RequiredAnswers. Any change to it will trigger the shiny alert to open and ask the user to confirm the first element of the RequiredAnswers vector. In other words, it removes the element that has just been answered with "No".

    Each answer to the alert will be caught by observeEvent(input$AnswerAlert, {}). If the response was "cancel" it dismisses the first element of RequiredAnswers thus triggering the next alert. This way we get a loop. If the response was "Ok" it will clear RequiredAnswers and no more alerts will be triggered (because observeEvent(RequiredAnswers(), {}) does not respond to RequiredAnswers == NULL.

    Drawback: if the user clicks 'Cancel' quite fast, Shiny does not recognize the event observeEvent(input$AnswerAlert, {}) does not get called. I cannot say for sure what the source of this is. My guess is a bug in Shiny Alert.

    Another way would be to do it recursively (see the section "Chaining modals" in the documentation). This way, the lost events may be avoided.

    library(shiny)
    library(shinyalert)
    
    ui <- fluidPage(
      actionButton("run", "Run"),
      verbatimTextOutput("answer", placeholder = TRUE)
    )
    
    server <- function(input, output, session) {
    
      RecentDecision <- reactiveVal()
      RequiredAnswers <- reactiveVal()
      
      # Responds to the alert being confirmed or dismissed
      observeEvent(input$AnswerAlert, {
        if (input$AnswerAlert) {
          Answer <- RequiredAnswers()[1]
          RecentDecision(Answer)
          print(RecentDecision())
          RequiredAnswers(NULL)
        } else {
          # Remove the first item of RequiredAnswers
          # Clear it completely when the end has been reached
          if (length(RequiredAnswers()) == 1) {
            RequiredAnswers(NULL)
            RecentDecision(NULL)
          }
          else
            RequiredAnswers(RequiredAnswers()[-1])
        }
      })
      
      # Responds to changes, ignores NULL
      observeEvent(RequiredAnswers(), {
        shinyalert(
          title = "Do you accept following element?",
          text = RequiredAnswers()[1],
          showCancelButton =  TRUE,
          inputId = "AnswerAlert"  # use individual id
        )
      })
      
      # Respond to the Run button
      observeEvent(input$run, {
        # Set up the vector of desired answers
        RequiredAnswers(c("A", "B", "C", "D", "E"))
      })
      
      output$answer <- renderText({
        if (!is.null(RecentDecision()))
          RecentDecision()
        else
          "No answer, yet"
      })
    }
    
    shinyApp(ui = ui, server = server)