Creazione di una finestra di dialogo popup interattiva

Question

Mi chiedevo se è possibile creare una finestra di dialogo popup interattiva utilizzando lucido (e lucidoBS).

Ad esempio, ho una stringa e voglio cambiarla e prima di fare una finestra di dialogo si presenta chiedendo se voglio davvero cambiarla. Nel caso in cui io dica "sì", lo fa altrimenti scarta il cambiamento. Ecco la mia prova, ma ho trovato due problemi: 1. se fai clic su "sì" o "no", nulla cambia 2. devi sempre chiudere la finestra in basso "chiudi".

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

Altre proposte sono più che benvenute !!

Answer 1

Ecco una proposta, ho principalmente cambiato il 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)) 

Un paio di punti:

ho creato un reactiveValues per contenere il nome che la persona attualmente ha. Questo è utile perché puoi aggiornare o non aggiornare questo valore quando la persona fa clic sul pulsante modale. È possibile accedere al nome utilizzando values$name.

È possibile utilizzare toggleModal per chiudere il modal una volta che l'utente ha cliccato su sì o no

Answer 2

Si può fare qualcosa del genere usando conditionalPanel, vorrei ulteriormente suggerire di aggiungere un pulsante per chiedere conferma oppose all'aggiornamento istantaneo.

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 fornito una bella soluzione. Ho intenzione di offrire una soluzione alternativa utilizzando invece il pacchetto shinyalert, che a mio avviso si traduce in un codice più semplice da comprendere (dichiarazione di non responsabilità: ho scritto che il pacchetto potrebbe essere di parte).

La differenza principale è che la creazione modale non è più nell'interfaccia utente e ora viene eseguita sul server quando si fa clic sul pulsante. Il modale utilizza una funzione di callback per determinare se si è fatto clic su "sì" o "no".

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