Question

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

例如，我有一个字符串，我想更改它，然后在做一个对话框显示询问我是否真的想要更改它。如果我说＆＃34;是＆＃34;，它会这样做，否则它会丢弃更改。这是我的尝试，但我发现了两个问题：1。如果你点击＆＃34;是＆＃34;或者＆＃34;不＆＃34;，没有任何变化2.你总是需要在底部关闭方框＆＃34;关闭＆＃34;。

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

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

3 个答案: