創建一個彈出式對話框交互式

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