Create a popup dialog box interactive

问题:

I was wondering if it is possible to create a popup dialog box interactive by using shiny (and shinyBS).

For example, I have a string and I want to change it and before doing a dialog box shows up asking if I really want to change it. In case I say "yes", it does it otherwise it discards the change. Here's my try but I found two issues: 1. if you click "yes" or "no", nothing changes 2. you always need to close the box by the bottom "close".

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 proposals are more than welcome!!

回答1:

Here's a proposition, I mainly changed the 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 couple of points:

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

You can use toggleModal to close the modal once the user has clicked on yes or no

回答2:

@NicE provided a nice solution. I'm going to offer an alternative solution using the shinyalert package instead, which I believe results in easier to understand code (disclaimer: I wrote that package so may be biased).

The main difference is that the modal creation is no longer in the UI and is now done on the server when the button is clicked. The modal uses a callback function to determine if "yes" or "no" were clicked.

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))

回答3:

You can do something like this using conditionalPanel, I would further suggest adding a button to ask for confirmation oppose to instant update.

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))