2016-01-15 8 views
5

Ich frage mich, ob es möglich ist, ein Popup-Dialogfeld interaktiv mit glänzenden (und shinyBS) zu erstellen.Erstellen Sie ein Popup-Dialogfeld interaktiv

Zum Beispiel habe ich eine Zeichenfolge und ich möchte es ändern, und vor dem Ausführen eines Dialogfelds zeigt sich gefragt, ob ich es wirklich ändern möchte. Falls ich "Ja" sage, tut es das, sonst verwirft es die Änderung. Hier ist mein Versuch, aber ich habe zwei Probleme gefunden: 1. Wenn Sie auf "Ja" oder "Nein" klicken, ändert sich nichts 2. Sie müssen immer die Box durch den unteren "Schließen" schließen.

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

Andere Vorschläge sind mehr als willkommen !!

Antwort

6

Hier ist ein Satz, änderte es in erster Linie des 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)) 

Ein paar Punkte:

habe ich ein reactiveValues die Namen zu halten, dass die Person zur Zeit hat. Dies ist nützlich, da Sie diesen Wert aktualisieren oder nicht aktualisieren können, wenn die Person auf die modale Schaltfläche klickt. Sie können auf den Namen mit values$name zugreifen.

können Sie toggleModal verwenden, um die modalen zu schließen, sobald der Benutzer auf Ja oder Nein

+0

Ich danke dir wirklich! Ich glaube, das war es, wonach ich suchte! Jetzt verstehe ich auch besser die Bedeutung von toggleModal (die Dokumentation ist ziemlich leer darüber) – Stefano

1

Sie können so etwas unter Verwendung von conditionalPanel tun, würde ich weiter vorschlagen, eine Schaltfläche hinzufügen, um die Bestätigung zu fragen, gegen sofortige Aktualisierung.

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

enter image description here

+0

Danke für den Vorschlag. Es funktioniert tatsächlich und es ist eine intelligente Umgehung des Problems, aber (meiner Meinung nach) der andere ist direkter. – Stefano

1

@NicE bot eine schöne Lösung geklickt hat. Ich werde stattdessen eine alternative Lösung anbieten, die das shinyalert Paket verwendet, was meiner Meinung nach zu einem einfacheren Code führt (Disclaimer: Ich habe dieses Paket so geschrieben, dass es voreingenommen sein kann).

Der Hauptunterschied besteht darin, dass die Modalerstellung nicht mehr in der Benutzeroberfläche vorhanden ist und jetzt auf dem Server ausgeführt wird, wenn auf die Schaltfläche geklickt wird. Das Modal verwendet eine Callback-Funktion, um festzustellen, ob "Ja" oder "Nein" geklickt wurde.

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