publicar - R brillante: muestra el mensaje "cargando..." mientras se ejecuta la función

shiny r tutorial

Question

Yo uso el paquete Shiny GUI R. Estoy buscando una manera de mostrar un mensaje como "cargando ..." después de presionar el botón de acción. La función tarda varios minutos en ejecutarse, por lo que debo informar al usuario de alguna forma que el botón realmente desencadenó algún evento. Ahora el código server.R se ve así:

DATA <- reactive({
  if(input$DownloadButton>0) {
    RunDownload()
  } else {
    NULL
  }
})

output$Download <- renderText({
  if(NROW(DATA())>0) {
    paste0(Sys.time(),": ",NROW(DATA()), " items downloaded")
  } else {
    ''''
  }
})

actionButton() es una función que descarga datos de internet. input$DownloadButton es actionButton. Entonces, después de presionar el botón, el usuario espera durante varios minutos y solo entonces ve un mensaje que dice que la descarga fue exitosa. Me gustaría mostrar un mensaje "Cargando ..." justo después de presionar el botón de acción y luego otro mensaje como paste0(Sys.time(),": ",NROW(DATA()), " items downloaded") cuando se ejecuta termina.

Answer 1

Encontré una solución que funciona bien para mí. Estoy usando el modal de Bootstrap. Se muestra cuando comienza la ejecución de la función y se oculta nuevamente cuando termina.

modalBusy <- function (id, title, ...) {

 msgHandler =  singleton(tags$head(tags$script(''Shiny.addCustomMessageHandler("jsCode",
                                            function(message) {
                                              console.log(message)
                                              eval(message.code);
                                            });''
                                            )
                                )
                      )

 label_id = paste(id, "label", sep=''-'')
 modal_tag <- div(id=id, 
               class="modal hide fade", 
               "aria-hidden"=FALSE, 
               "aria-labelledby"=label_id, 
               "role"="dialog", 
               "tabindex"="-1",
               "data-keyboard"=FALSE,
               "data-backdrop"="static")
 header_tag <- div(class="modal-header",
                h3(id=label_id, title))
 body_tag <- div(class="modal-body",
              Row(...))   
 footer_tag <- div(class="modal-footer")
 modal_tag <- tagAppendChildren(modal_tag, header_tag, body_tag, footer_tag)
 tagList(msgHandler, modal_tag) 
}

Para mostrar y ocultar, use las funciones

showModal <- function(id,session) {
  session$sendCustomMessage(type="jsCode",
                            list(code= paste("$(''#",id,"'').modal(''show'')"
                                             ,sep="")))
}

hideModal <- function(id,session) {
  session$sendCustomMessage(type="jsCode",
                            list(code= paste("$(''#",id,"'').modal(''hide'')"
                                             ,sep="")))
}

¡Llame a la función showModal antes de su función Call y luego a la función hideModal!

Espero que esto ayude.

Seb

Answer 2

Puede usar ShinyJS: https://github.com/daattali/shinyjs

Cuando se presiona el botón de acción, puede alternar fácilmente un componente de texto que muestra "cargando ...", y cuando finaliza el cálculo, puede alternar este componente a oculto.

Answer 3

Resolví el problema agregando el siguiente código a sidebarPanel ():

HTML(''<script type="text/javascript">
        $(document).ready(function() {
          $("#DownloadButton").click(function() {
            $("#Download").text("Loading...");
          });
        });
      </script>
'')

Answer 4

Ya estoy usando una forma más simple y confiable que la que publiqué antes.

Una combinación de

tags$style(type="text/css", "
           #loadmessage {
             position: fixed;
             top: 0px;
             left: 0px;
             width: 100%;
             padding: 5px 0px 5px 0px;
             text-align: center;
             font-weight: bold;
             font-size: 100%;
             color: #000000;
             background-color: #CCFF66;
             z-index: 105;
           }
  ")

con

conditionalPanel(condition="$(''html'').hasClass(''shiny-busy'')",
                 tags$div("Loading...",id="loadmessage")
)

Ejemplo:

runApp(list(
  ui = pageWithSidebar(
      headerPanel("Test"),
         sidebarPanel(
           tags$head(tags$style(type="text/css", "
             #loadmessage {
               position: fixed;
               top: 0px;
               left: 0px;
               width: 100%;
               padding: 5px 0px 5px 0px;
               text-align: center;
               font-weight: bold;
               font-size: 100%;
               color: #000000;
               background-color: #CCFF66;
               z-index: 105;
             }
          ")),
           numericInput(''n'', ''Number of obs'', 100),
           conditionalPanel(condition="$(''html'').hasClass(''shiny-busy'')",
                            tags$div("Loading...",id="loadmessage"))
         ),
         mainPanel(plotOutput(''plot''))
  ),
  server = function(input, output) {
    output$plot <- renderPlot({ Sys.sleep(2); hist(runif(input$n)) })
  }
))

No se requiere etiquetas $ head (), pero es una buena práctica mantener todos los estilos dentro de la etiqueta principal.