Shiny: how to create a confirm dialog box

Question

I would like to ask if it is possible to have a confirm dialog box, consisting of two buttons, in shiny. Say, if I click a Delete button, then the dialog box pop up. User pick the choice and return. The app acts according to the user choice.

Answer 1

Neither ShinyBS nor Javascript is necessary. The trick is to use a modalDialog and set the footer to be a tagList of several tags, usually, an actionButton for the delete and a modalButton to cancel. Below is a MWE

app.R

library(shiny)

ui = fluidPage(
   mainPanel(
       actionButton("createfile", "Create"),
       actionButton("deletefile", "Delete")
   )
)

# Define server logic required to draw a histogram
server = function(session, input, output) {

   observeEvent(input$createfile, {
       showModal(modalDialog(
           tagList(
               textInput("newfilename", label = "Filename", placeholder = "my_file.txt")
           ), 
           title="Create a file",
           footer = tagList(actionButton("confirmCreate", "Create"),
                            modalButton("Cancel")
           )
       ))
   })


   observeEvent(input$deletefile, {
       showModal(modalDialog(
           tagList(
               selectInput("deletefilename", label = "Delete a file", choices = list.files(pattern="*.txt"))
           ), 
           title="Delete a file",
           footer = tagList(actionButton("confirmDelete", "Delete"),
                            modalButton("Cancel")
           )
       ))
   })

   observeEvent(input$confirmCreate, {
       req(input$newfilename)
       file.create(input$newfilename)
       removeModal()
   })

   observeEvent(input$confirmDelete, {
       req(input$deletefilename)
       file.remove(input$deletefilename)
       removeModal()
   })
}

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

Note, if you use shiny modules, you have to use session$ns("inputID") rather than ns("inputID"). See Tobias' answer here.

Answer 2

Update using sweetalertR

#install_github("timelyportfolio/sweetalertR")
library(shiny)
library(sweetalertR)
runApp(shinyApp(
  ui = fluidPage(
    actionButton("go", "Go"),
    sweetalert(selector = "#go", text = "hello", title = "world")
  ),

  server = function(input, output, session) {
  }
))

Example 1

You can do something like this, note that the code is taken from Demo on submit button with pop-up (IN PROGRESS)

rm(list = ls())
library(shiny)

ui =basicPage(
  tags$head(
    tags$style(type='text/css', 
               "select, textarea, input[type='text'] {margin-bottom: 0px;}"
               , "#submit {
          color: rgb(255, 255, 255);
          text-shadow: 0px -1px 0px rgba(0, 0, 0, 0.25);
          background-color: rgb(189,54,47);
          background-image: -moz-linear-gradient(center top , rgb(238,95,91), rgb(189,54,47));
          background-repeat: repeat-x;
          border-color: rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);
        }"
    ),
    tags$script(HTML('
          Shiny.addCustomMessageHandler("jsCode",
            function(message) {
              eval(message.value);
            }
          );'
    ))
  )
  ,
  textInput(inputId = "inText", label = "", value = "Something here")
  ,
  actionButton(inputId = "submit", label = "Submit")
  #  
  #   alternative approach: button with pop-up
  #    , tags$button("Activate", id = "ButtonID", type = "button", class = "btn action-button", onclick = "return confirm('Are you sure?');" )
  ,
  tags$br()
  ,
  tags$hr()
  ,
  uiOutput("outText")
)
server = (
  function(session, input, output) {

    observe({
      if (is.null(input$submit) || input$submit == 0){return()}
      js_string <- 'alert("Are You Sure?");'
      session$sendCustomMessage(type='jsCode', list(value = js_string))
      text <- isolate(input$inText)
      output$outText <- renderUI({
        h4(text)
      })
    })

  }
)
runApp(list(ui = ui, server = server))

Example 2

Using ShinyBS package

rm(list = ls())
library(shiny)
library(shinyBS)

campaigns_list <- letters[1:10]

ui =fluidPage(
  checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list),
  actionLink("selectall","Select All"),
  bsModal("modalExample", "Yes/No", "selectall", size = "small",wellPanel(
    actionButton("no_button", "Yes"),
    actionButton("yes_button", "No")
    ))
)
server = function(input, output, session) {

  observe({
    if(input$selectall == 0) return(NULL) 
    else if (input$selectall%%2 == 0)
    {
      updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list)      
    }
    else
    {
      updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list)
    }
  })


}
runApp(list(ui = ui, server = server))

Edit for Apricot

rm(list = ls())
library(shiny)
library(shinyBS)

campaigns_list <- letters[1:10]

ui =fluidPage(
        checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list),
        actionLink("selectall","Select All"),
        bsModal("modalExample", "Yes/No", "selectall", size = "small",wellPanel(
                actionButton("yes_button", "Yes"),
                actionButton("no_button", "No")
        ))
)
server = function(input, output, session) {

        observeEvent(input$no_button,{
                updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list) 
        })

        observeEvent(input$yes_button,{
                updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list)
        })
}
runApp(list(ui = ui, server = server))