Создать всплывающее диалоговое окно интерактивное

Question

Мне было интересно, если это возможно, чтобы создать всплывающее диалоговое окно, интерактивное с помощью Shiny (и ShineBS).

Например, у меня есть строка, и я хочу ее изменить, и перед тем, как сделать это, появится диалоговое окно с вопросом, действительно ли я хочу ее изменить. Если я говорю "да", он делает это, в противном случае он отменяет изменение. Вот моя попытка, но я обнаружил две проблемы: 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 пакет вместо этого, который, как я считаю, приводит к более простому пониманию кода (отказ от ответственности: я написал, что пакет может быть предвзятым)

Основное отличие состоит в том, что модальное создание больше не в пользовательском интерфейсе и теперь выполняется на сервере при нажатии кнопки. Модал использует функцию обратного вызова, чтобы определить, были ли нажаты кнопки "да" или "нет".

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