Yes/No dialog box

[julie...@gmail.com]

Hi I have a function which require user interaction (with console prompt actually) and I would like to implement it with Shiny.

The function performs some calculations and in case of "problem" it needs an user interaction to decide to continue or not the computations, so I would like to create a yes/no dialog box in Shiny.

I couldn't find a solution on internet so I tried to build my own dialog box through modal windows.

But I have two problems, when I can't manage to make the application pause stop and wait for the user interaction (i.e. the button click) and the code keep running regardless of the user interaction.

My second problem is that I would like to have only to call function in the server side, but I don't know if this is really possible. For example just in the server side : myLogical <- confirmDialogBox() without "declaring" the dialog box in the client side before (like I'm doing here).

Any help would be highly appreciated ! Thanks !

Here is what I tried so far :

#### App

ui <- fluidPage(
  actionButton("button", "Button"),
  confirmDialogBox("modal", "title", "continue ?..."),
  verbatimTextOutput("out")
)

server <- function(input, output, session) {
  observe({
    if(input$button > 0) {
      output$out <- renderPrint({fun(input, session)})
    }
  })
}

fun <- function(input, session) {
  session$sendCustomMessage(type = "showmodal", message = "modal")
  if (isolate(input$modal))
    print("CONTINUE")
  else
    print("STOP")
}

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

#### confirmDialogBox

confirmDialogBox <- function(inputId, label, dialog, size = "medium") {
 
  classDialog <- switch(size,
                        small = "modal-dialog modal-lg",
                        medium = "modal-dialog", 
                        large = "modal-dialog modal-lg",
                        "modal-dialog")
 
  tagList(
    singleton(tags$head(
      includeScript("./confirm.js"),
      tags$script("Shiny.addCustomMessageHandler('showmodal', function(message) {$('#' + message).modal('show');});")
    )),
    div(id = inputId, class = "modal fade confirm", role = "dialog",
        div(class = classDialog,
            div(class = "modal-content",
                div(class = "modal-header",
                    HTML("<button type='button' class='close' data-dismiss='modal'>&times;</button>"),
                    h4(class = "modal-title", label)
                ),
                div(class = "modal-body",
                    p(dialog)
                ),
                div(class = "modal-footer",
                    tags$button(id = "confirmYes", class = "btn btn-default true-btn", `data-dismiss` = "modal", type = "button", "Oui"),
                    tags$button(id = "confirmNo", class = "btn btn-default false-btn", `data-dismiss` = "modal", type = "button", "Non")
                )
            )
        )
    )
  )
}

registerInputHandler("confirm", function(value, ...) {
  value
}, force = TRUE)

#### confirm.js

(function() {
 
  var value;
 
  $(document).on("click", ".confirm button.right-btn", function() {
    value = true;
  });
 
  $(document).on("click", ".confirm button.false-btn", function() {
    value = false;
  });
 
  var binding = new Shiny.InputBinding();
 
  binding.find = function(scope) {
    return $(scope).find(".confirm");
  };
 
  binding.getValue = function() {
    return value;
  };
 
  binding.subscribe = function(el, callback) {
    $(el).on("change.confirmBinding", function(e) {
      callback();
    });
  };
 
  binding.unsubscribe = function(el) {
    $(el).off(".confirmBinding");
  };
 
  binding.getType = function() {
    return "confirm";
  };
 
  Shiny.inputBindings.register(binding, "confirm");
 
})();

[julie...@gmail.com]

I found a way which works and allows me to call only a handler in the ui. But this is browser dependent so I can't add css for the confirm window.

registerConfirmBox <- function(type) {

  singleton(tags$head(tags$script(

    HTML(paste0("Shiny.addCustomMessageHandler(type ='", type, "', function(message) {

         Shiny.onInputChange(message.id, eval(message.value));

         });")

    )

  )))

}

confirmBox <- function(session, inputId, message, type) {

  session$sendCustomMessage(type = type, list(value = paste0("confirm('", message, "');"), id = inputId))

}

ui <- fluidPage(

  registerConfirmBox("confirmBox"), 

  actionButton("go", "go"), 

  verbatimTextOutput("out"), 

  actionButton("go2", "go"), 

  verbatimTextOutput("out2")

)

server <- function(input, output, session) {

  observe({

    if (input$go > 0) {

      confirmBox(session, "confirmid", "Confirmer ?", "confirmBox")

      output$out <- renderPrint({

        if (isTRUE(input$confirmid)) {

          print("ok")

        } else {

          print("stop")

        }

      })

    }

  })

  observe({

    if (input$go2 > 0) {

      confirmBox(session, "confirmid2", "Confirmer ?", "confirmBox")

      output$out2 <- renderPrint({

        if (isTRUE(input$confirmid2)) {

          print("ok")

        } else {

          print("stop")

        }

      })

    }

  })

}

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