Shiny: Wie erstelle ich ein Bestätigungsdialogfeld

Question

Ich möchte fragen, ob es möglich ist, ein Bestätigungsdialogfeld, bestehend aus zwei Schaltflächen, glänzend zu haben. Angenommen, ich klicke auf eine Schaltfläche Löschen, dann wird das Dialogfeld angezeigt. Benutzer wählen die Auswahl und zurück. Die App handelt nach der Benutzerwahl.

Answer 1

ich Teil des Codes geändert

js_string <- 'confirm("Are You Sure?");' 
session$sendCustomMessage(type='jsCode', list(value = js_string)) 

zu nennen

, um den Bestätigungsdialog anstelle des Alarmdialogfelds aufzurufen. Dann

tags$script(
      HTML(' 
       Shiny.addCustomMessageHandler(
        type = "jsCode" 
        ,function(message) { 
        Shiny.onInputChange("deleteConfirmChoice",eval(message.value)); 
       }) 
      ') 
) 

den Wert durch das Bestätigungsdialogfeld zurück zu senden. Dann habe ich einfach den Wert der Eingabe $ deleteConfirmChoice überprüft, um festzustellen, welche Aktion ausgeführt werden soll. Vielen Dank! Ich verstehe jetzt, wie man Nachrichten von und zu R und Javascript sendet und empfängt.

Answer 2

aktualisieren mit sweetalertR

#install_github("timelyportfolio/sweetalertR") 
library(shiny) 
library(sweetalertR) 
runApp(shinyApp(
    ui = fluidPage(
    actionButton("go", "Go"), 
    sweetalert(selector = "#go", text = "hello", title = "world") 
), 

    server = function(input, output, session) { 
    } 
)) 

Beispiel 1

Sie können so etwas tun, beachten Sie, dass der Code von Demo on submit button with pop-up (IN PROGRESS)

rm(list = ls()) 
library(shiny) 

ui =basicPage(
    tags$head(
    tags$style(type='text/css', 
       "select, textarea, input[type='text'] {margin-bottom: 0px;}" 
       , "#submit { 
      color: rgb(255, 255, 255); 
      text-shadow: 0px -1px 0px rgba(0, 0, 0, 0.25); 
      background-color: rgb(189,54,47); 
      background-image: -moz-linear-gradient(center top , rgb(238,95,91), rgb(189,54,47)); 
      background-repeat: repeat-x; 
      border-color: rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25); 
     }" 
    ), 
    tags$script(HTML(' 
      Shiny.addCustomMessageHandler("jsCode", 
      function(message) { 
       eval(message.value); 
      } 
     );' 
    )) 
) 
    , 
    textInput(inputId = "inText", label = "", value = "Something here") 
    , 
    actionButton(inputId = "submit", label = "Submit") 
    # 
    # alternative approach: button with pop-up 
    # , tags$button("Activate", id = "ButtonID", type = "button", class = "btn action-button", onclick = "return confirm('Are you sure?');") 
    , 
    tags$br() 
    , 
    tags$hr() 
    , 
    uiOutput("outText") 
) 
server = (
    function(session, input, output) { 

    observe({ 
     if (is.null(input$submit) || input$submit == 0){return()} 
     js_string <- 'alert("Are You Sure?");' 
     session$sendCustomMessage(type='jsCode', list(value = js_string)) 
     text <- isolate(input$inText) 
     output$outText <- renderUI({ 
     h4(text) 
     }) 
    }) 

    } 
) 
runApp(list(ui = ui, server = server)) 

genommen wird

Beispiel 2

Mit ShinyBS Paket

rm(list = ls()) 
library(shiny) 
library(shinyBS) 

campaigns_list <- letters[1:10] 

ui =fluidPage(
    checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list), 
    actionLink("selectall","Select All"), 
    bsModal("modalExample", "Yes/No", "selectall", size = "small",wellPanel(
    actionButton("no_button", "Yes"), 
    actionButton("yes_button", "No") 
    )) 
) 
server = function(input, output, session) { 

    observe({ 
    if(input$selectall == 0) return(NULL) 
    else if (input$selectall%%2 == 0) 
    { 
     updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list)  
    } 
    else 
    { 
     updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list) 
    } 
    }) 


} 
runApp(list(ui = ui, server = server)) 

Edit für Aprikose

rm(list = ls()) 
library(shiny) 
library(shinyBS) 

campaigns_list <- letters[1:10] 

ui =fluidPage(
     checkboxGroupInput("campaigns","Choose campaign(s):",campaigns_list), 
     actionLink("selectall","Select All"), 
     bsModal("modalExample", "Yes/No", "selectall", size = "small",wellPanel(
       actionButton("yes_button", "Yes"), 
       actionButton("no_button", "No") 
     )) 
) 
server = function(input, output, session) { 

     observeEvent(input$no_button,{ 
       updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list) 
     }) 

     observeEvent(input$yes_button,{ 
       updateCheckboxGroupInput(session,"campaigns","Choose campaign(s):",choices=campaigns_list,selected=campaigns_list) 
     }) 
} 
runApp(list(ui = ui, server = server))