Создайте диалоговое окно всплывающих окон в интерактивном режиме

Question

Мне было интересно, можно ли создать диалоговое окно всплывающего окна интерактивным, используя блестящие (и 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 закрыть модальный когда пользователь нажал на да или нет

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