Create a popup dialog box

Question

I was wondering if it is possible to make a popup dialog interactive using brilliant (and shinyBS).

For example, I have a line, and I want to change it, and before I make a dialog box, a question will appear whether I really want to change it. In case I say yes, he does it differently, it discards the change. Here is my attempt, but I found two questions: 1. If you click “yes” or “no”, nothing will change 2. you always need to close the “close” window.

rm(list = ls()) library(shiny) library(shinyBS) name <- "myname" ui =fluidPage( textOutput("curName"), br(), textInput("newName", "Name of variable:", name), br(), actionButton("BUTnew", "Change"), bsModal("modalnew", "Change name", "BUTnew", size = "small", textOutput("textnew"), actionButton("BUTyes", "Yes"), actionButton("BUTno", "No") ) ) server = function(input, output, session) { output$curName <- renderText({paste0("Current name: ", name)}) observeEvent(input$BUTnew, { output$textnew <- renderText({paste0("Do you want to change the name?")}) }) observeEvent(input$BUTyes, { name <- input$newName }) } runApp(list(ui = ui, server = server)) 

Other suggestions are more than welcome!

Answer 1

Here's a suggestion, I basically changed server.R :

 library(shiny) library(shinyBS) ui =fluidPage( textOutput("curName"), br(), textInput("newName", "Name of variable:", "myname"), br(), actionButton("BUTnew", "Change"), bsModal("modalnew", "Change name", "BUTnew", size = "small", HTML("Do you want to change the name?"), actionButton("BUTyes", "Yes"), actionButton("BUTno", "No") ) ) server = function(input, output, session) { values <- reactiveValues() values$name <- "myname"; output$curName <- renderText({ paste0("Current name: ", values$name) }) observeEvent(input$BUTyes, { toggleModal(session, "modalnew", toggle = "close") values$name <- input$newName }) observeEvent(input$BUTno, { toggleModal(session, "modalnew", toggle = "close") updateTextInput(session, "newName", value=values$name) }) } runApp(list(ui = ui, server = server)) 

A few points:

I created reactiveValues to store the name that a person has. This is useful because you can update or not update this value when a person presses the modal button. You can access the name using values$name .

You can use toggleModal to close the modal as soon as the user clicks "Yes" or "No"

Answer 2

@NicE provided a nice solution. I am going to propose an alternative solution using shinyalert instead, which, in my opinion, simplifies the understanding of the code (disclaimer: I wrote this package, so it may be biased).

The main difference is that modal creation is no longer in the user interface and now runs on the server when a button is clicked. The modal uses the callback function to determine if yes or no have been pressed.

 library(shiny) library(shinyalert) ui <- fluidPage( useShinyalert(), textOutput("curName"), br(), textInput("newName", "Name of variable:", "myname"), br(), actionButton("BUTnew", "Change") ) server = function(input, output, session) { values <- reactiveValues() values$name <- "myname" output$curName <- renderText({ paste0("Current name: ", values$name) }) observeEvent(input$BUTnew, { shinyalert("Change name", "Do you want to change the name?", confirmButtonText = "Yes", showCancelButton = TRUE, cancelButtonText = "No", callbackR = modalCallback) }) modalCallback <- function(value) { if (value == TRUE) { values$name <- input$newName } else { updateTextInput(session, "newName", value=values$name) } } } runApp(list(ui = ui, server = server)) 

Answer 3

You can do something like this with a conditionalPanel , I would also suggest adding a button to ask for confirmation to withstand instant updates.

 rm(list = ls()) library(shiny) library(shinyBS) name <- "myname" ui = fluidPage( uiOutput("curName"), br(), actionButton("BUTnew", "Change"), bsModal("modalnew", "Change name", "BUTnew", size = "small", textOutput("textnew"), radioButtons("change_name", "", choices = list("Yes" = 1, "No" = 2, "I dont know" = 3),selected = 2), conditionalPanel(condition = "input.change_name == '1'",textInput("new_name", "Enter New Name:", "")) ) ) ) server = function(input, output, session) { output$curName <- renderUI({textInput("my_name", "Current name: ", name)}) observeEvent(input$BUTnew, { output$textnew <- renderText({paste0("Do you want to change the name?")}) }) observe({ input$BUTnew if(input$change_name == '1'){ if(input$new_name != ""){ output$curName <- renderUI({textInput("my_name", "Current name: ", input$new_name)}) } else{ output$curName <- renderUI({textInput("my_name", "Current name: ", name)}) } } }) } runApp(list(ui = ui, server = server))