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

Question

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

例如，我有一个字符串，我想改变它，并在做对话框之前显示询问我是否真的想改变它。如果我说“是”，它会这样做，否则它会放弃更改。这是我的尝试，但我发现了两个问题：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关闭模式，一旦用户点击yes或no

Answer 2

您可以使用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 3

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

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

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