r语言 - 在处理数据时更新闪亮的界面

Question

如何在处理数据时更新接口?

全文如下:

我在一个docker容器中运行一个闪亮的应用程序。在启动应用程序之前，我需要下载大量数据(这需要一些时间)。在此期间，它是不可能连接到闪亮的web服务器-因为它还没有启动。但是，我想做一个简单的页面"请等待，正在下载数据(XX%)"或者类似的东西，一旦数据被加载，停止应用程序并运行另一个。

下面是一段可以工作的代码。也就是说，应用程序运行时，执行"处理块";当"数据加载"时完成后，调用stopApp并返回结果。但是，直到所有的"工作"完成后才会呈现输出。

library(shiny)
ui <- fluidPage(
titlePanel("Please wait!"),
fluidRow(
textOutput("msg")))
srv <- function(input, output) {
output$msg <- renderText("Waiting")
observe({
## the data loading block
message("doing the job")
Sys.sleep(10)
message("proceeding")
output$msg <- renderText("OK, proceeding")
Sys.sleep(10)
output$msg <- renderText("Nearly finished")
message("nearly")
Sys.sleep(10)
message("done")
stopApp(list(a=1, b=2))
})
}
foo <- runApp(shinyApp(ui=ui, server=srv))

现在，我做错了什么?更奇怪的是，即使是"请稍等";renderText调用不会执行，直到一切都完成。

我认为问题是冲水。我假设shiny等待与浏览器中的JS通信，直到所有响应式表达式完成计算。我不知道如何让它立即更新UI

我想可以将处理分解成一系列相互依赖的反应性表达式，并与接口交互，一点一点地更新接口，但首先，这将很难扩展(我需要加载几个数据集，我不知道他们的数字事先)，其次，它会看起来很奇怪。最重要的是，我尝试了几种方法，但都失败了。我想到的最佳解决方案是这样的:

ui <- fluidPage(
titlePanel("Please wait!"),
fluidRow(
numericInput("xxx", label="testlab", value=0),
textOutput("msg")))
srv <- function(input, output, session) {
steps <- reactiveVal(1)
observe({
message("starting stuff")
updateNumericInput(session=session, inputId="xxx", value=1)
})

observeEvent(input$xxx, {
n <- req(input$xxx)
message("Running job ", n)
Sys.sleep(10)
updateNumericInput(inputId="xxx", value=n + 1)
if(n == 3) {
stopApp(list(steps=n, done=TRUE))
}
})
output$msg <- renderText({
n <- req(input$xxx)
return(sprintf("Processing job %d", n))
})
}
foo <- runApp(shinyApp(ui=ui, server=srv))

有一个简单的技巧我错过了吗?

Answer 1

像这样?源

library(shiny)
library(waiter)
ui <- fluidPage(
useWaitress(),
p("App content")
)
server <- function(input, output){
# call the waitress
waitress <- Waitress$
new(theme = "overlay-percent")$
start() # start
# insert data loading here instead of the for loop
# put some waitress$inc(X) between loading data if your data
# is composed of several variables
for(i in 1:10){
waitress$inc(10) # increase by 10%
Sys.sleep(.3)
}
# hide when it's done
waitress$close() 
}
shinyApp(ui, server)