创建一个交互的弹出对话框

Question

我想知道是否可以使用 shiny（和 shinyBS）创建一个交互的弹出对话框。

例如，我有一个字符串，我想更改它，但在执行之前会出现一个对话框，询问我是否真的要更改它。如果我说 "yes"，它会这样做，否则它会放弃更改。这是我的尝试，但我发现了两个问题：1. 如果你点击 "yes" 或 "no"，没有任何变化 2. 你总是需要关闭底部的框 "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))

非常欢迎其他建议！！

Answer 1

您可以使用 conditionalPanel 做类似的事情，我进一步建议添加一个按钮来要求确认反对即时更新。

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

Answer 2

这里有个命题，我主要改了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))

几点：

我创建了一个 reactiveValues 来保存此人当前的姓名。这很有用，因为您可以在用户单击模式按钮时更新或不更新此值。您可以使用 values$name.

访问名称

您可以使用 toggleModal 在用户点击是或否后关闭模式

Answer 3

@NicE 提供了一个很好的解决方案。我将提供一个使用 shinyalert 包的替代解决方案，我相信这会使代码更容易理解（免责声明：我写了那个包，所以可能有偏见）。

主要区别在于模式创建不再在 UI 中，现在是在单击按钮时在服务器上完成。模态框使用回调函数来确定 "yes" 或 "no" 是否被点击。

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

创建一个交互的弹出对话框

Create a popup dialog box interactive

r

shiny

shinybs