R闪亮的两个输出，一个操作按钮

Question

我正在尝试使用R Shiny中的操作按钮来启动运行缓慢的JAGS模型。我希望当用户第一次单击该按钮时出现一些文本，该文本显示他们按下按钮的时间，以便他们知道发生了什么。

到目前为止，“操作”按钮可以正常工作，但是要等到运行缓慢的模型完成后才能显示模型输出和文本。

我已经看过以下问题，但它们似乎并不能回答我的问题，至少不是以我理解的方式：  R Shiny execute order Pattern for triggering a series of Shiny actions

我是Shiny的新手，所以我希望这是一个简单的问题。

Run.me <- function(a){
# some fake slow function
# This actually takes about 8 hours in real life 

for (i in 2:a) {
Foo[i] <<- Foo[i-1] + sample(1:20,1)
}}

library(shiny)

定义服务器逻辑----

server <- function(input, output) {

observeEvent(input$runmodel, {
output$model.running <- renderText({paste("Model started at", Sys.time())})
})

observeEvent(input$runmodel, {
Foo <<- rep(1, 1e6)
Run.me(1e6)
output$model.ran <- renderTable({head(Foo)})
})

}

定义UI ----

ui <- fluidPage(

fluidRow(
column(5, align = "center",
       actionButton("runmodel", "Run the Model")),
textOutput("model.running")
),


fluidRow(
column(5, align = "center", tableOutput("model.ran"))
)
)

运行应用程序----

shinyApp(ui = ui, server = server)

Answer 1

在也正在缓慢构建模型的应用程序中，我使用服务器中的进度条。我知道这并不是您所要的，但您可能会找到一个可以接受的解决方案。

modeloutput= reactive(withProgress(message = 'Generating JAGs model', value = 0, {
    incProgress(50); generate_jags(params)
}))

output$jags = renderPlot(modeloutput())

我还将关注该问题的答案，因为我也希望一种解决方案，该解决方案在实际的绘图窗口中具有一条消息或加载栏，在该窗口中将显示输出。

我还发现了另一种解决方案，该解决方案可以通过单击操作按钮并显示一个小的加载栏和完成消息来阻止该操作按钮。它在这里可用：

https://github.com/daattali/advanced-shiny/tree/master/busy-indicator

Answer 2

一种可能，如果我正确理解了这个问题：

server <- function(input, output) {

  observeEvent(input$runmodel, {
    Foo <<- rep(1, 1e6)
    Run.me(1e6)
    output$modelran <- renderTable({head(Foo)})
  })

}

js <- "
$(document).ready(function() {
  $('#runmodel').on('click', function(){
    var date = new Date().toLocaleString();
    $('#busy').html('Model started: ' + date);
  });
  $('#modelran').on('shiny:value', function(event) {
    $('#busy').html('');
  });
});
"

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),

  fluidRow(
    column(5, align = "center",
           actionButton("runmodel", "Run the Model")),
    tags$p(id = "busy")
  ),
  fluidRow(
    column(5, align = "center", tableOutput("modelran"))
  )

)