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

Вот предложение, я в основном изменил 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, чтобы закрыть модальное окно после того, как пользователь нажал «да» или «нет».

@NicE предоставил хорошее решение. Я собираюсь предложить альтернативное решение с использованием пакета shinyalert, который, как мне кажется, упрощает понимание code (отказ от ответственности: я написал этот пакет, поэтому могу быть предвзятым).

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

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

Вы можете сделать что-то подобное, используя 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))