r - 创建交互式弹出对话框

Question

我想知道是否可以使用闪亮（和闪亮BS）创建一个交互式弹出对话框。

例如，我有一个字符串，我想更改它，在执行之前会出现一个对话框，询问我是否真的要更改它。如果我说“是”，它会这样做，否则它会丢弃更改。这是我的尝试，但我发现了两个问题：1.如果单击“是”或“否”，则没有任何变化 2.您始终需要关闭底部的“关闭”框。

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

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

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

主要区别在于模态创建不再在 UI 中，而是在单击按钮时在服务器上完成。模式使用回调函数来确定是否单击了“是”或“否”。

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

你可以使用 来做这样的事情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))