57

我使用闪亮的 GUI R 包。我正在寻找一种在按下 actionButton 后显示类似“正在加载...”的消息的方法。该功能需要几分钟才能执行，因此我需要以某种方式通知用户该按钮实际上触发了某些事件。现在 server.R 代码如下所示：

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()是从互联网下载数据的功能。input$DownloadButton是动作按钮。因此，在按下按钮后，用户等待几分钟，然后才看到一条消息说下载成功。我想在按下 actionButton 之后显示一条消息“正在加载...”，然后paste0(Sys.time(),": ",NROW(DATA()), " items downloaded")在执行结束时显示另一条消息。

4

6 回答 6

42

我已经使用了一种比我之前发布的更简单、更可靠的方法。

的组合

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;
           }
  ")

和

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

例子：

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

tags$head() 不是必需的，但最好将所有样式保留在 head 标签内。

于 2014-03-18T09:33:07.747 回答
27

showModal()非常简单，您可以在函数的开头和removeModal()结尾使用内置的闪亮函数。如果您删除页脚，则无法单击该模式。

例子：

observeEvent(input$button, {
     showModal(modalDialog("Doing a function", footer=NULL))
     #Do the stuff here....
     #...
     #...
     #Finish the function
     removeModal()
})
于 2018-10-10T13:49:09.517 回答
4

我通过将以下代码添加到 sidebarPanel() 解决了这个问题：

HTML('<script type="text/javascript">
        $(document).ready(function() {
          $("#DownloadButton").click(function() {
            $("#Download").text("Loading...");
          });
        });
      </script>
')
于 2013-06-27T08:56:20.450 回答
3

你可以使用 ShinyJS：https ://github.com/daattali/shinyjs

当按下 actionButton 时，您可以轻松切换显示“正在加载...”的文本组件，当计算完成后，您可以将该组件切换为隐藏状态。

于 2016-08-19T02:33:39.580 回答
3

虽然这个问题很老，但我认为它仍然是相关的。我提供了另一种解决方案，它在按钮上显示活动指示器，在按钮标签旁边开始一个冗长的过程。

带有活动指示器的按钮

我们需要一个带有标签的操作按钮，span并以某种方式识别该标签。

actionButton("btnUpdate", span("Update", id="UpdateAnimate", class=""))

我们还需要一些可以添加到按钮标签的 CSS 动画，例如：

            tags$head(tags$style(type="text/css", '
            .loading {
                display: inline-block;
                overflow: hidden;
                height: 1.3em;
                margin-top: -0.3em;
                line-height: 1.5em;
                vertical-align: text-bottom;
                box-sizing: border-box;
            }
            .loading.dots::after {
                text-rendering: geometricPrecision;
                content: "⠋\\A⠙\\A⠹\\A⠸\\A⠼\\A⠴\\A⠦\\A⠧\\A⠇\\A⠏&quot;;
                animation: spin10 1s steps(10) infinite;
                animation-duration: 1s;
                animation-timing-function: steps(10);
                animation-delay: 0s;
                animation-iteration-count: infinite;
                animation-direction: normal;
                animation-fill-mode: none;
                animation-play-state: running;
                animation-name: spin10;
            }
            .loading::after {
                display: inline-table;
                white-space: pre;
                text-align: left;
            }
            @keyframes spin10 { to { transform: translateY(-15.0em); } }
            '))

现在我们可以shinyjs用来操作span在按钮标签后面动态添加动画的类。一旦用户按下按钮，我们就会添加动画：

    observeEvent(input$btnUpdate, { # User requests update
        # ... 

        shinyjs::addClass(id = "UpdateAnimate", class = "loading dots")
        shinyjs::disable("btnUpdate")
        
        # ...
    })

操作完成后，我们可以从 span 中删除类并结束动画：

    output$distPlot <- renderPlot({
        # ...
        
        Sys.sleep(1) # just for show, you probably want to remove it in a real app
        # Button settings        
        shinyjs::enable("btnUpdate")
        shinyjs::removeClass(id = "UpdateAnimate", class = "loading dots")

        # ...
    })

示例应用程序的完整代码可在 GitHub 上作为 gist 获得。

于 2021-01-05T12:32:06.937 回答
2

我找到了一个解决方案，对我来说很好。我正在使用 Bootstrap 模式。它在函数执行开始时显示，在结束时再次隐藏。

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

要显示和隐藏它，请使用函数

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="")))
}

在你的函数调用之前调用 showModal 函数，然后调用 hideModal 函数！

希望这可以帮助。

塞布

于 2014-02-27T17:47:00.000 回答