在 Shiny 中显示文本进度条

Question

所以我想为在控制台中显示进度的长时间运行的函数long_run_op 创建一个 shinydashboardPlus GUI。这是该函数的一个最小示例：

    long_run_op <- function() {
        pb <- txtProgressBar(style=3, max=10)
        for(i in 1:10) {Sys.sleep(0.1); setTxtProgressBar(pb, i)}
        close(pb)
        return(rnorm(10))
    }

（如果你有兴趣：我想用很棒的keyATM::keyATM，不能和shiny::withProgress一起使用。）

现在我希望在闪亮的应用程序中显示控制台进度条。

到目前为止，我尝试的是使用verbatimTextOutput。这仅显示返回值。此外，服务器功能使用<<-，这不仅闻起来像坏习惯，甚至不起作用——情节从未显示。

（编辑：绘图未显示是因为 ui 中的函数错误，现在已修复，感谢@stefan。）

    ui <- shinydashboardPlus::dashboardPage(
        header=shinydashboardPlus::dashboardHeader(),
        sidebar = shinydashboardPlus::dashboardSidebar(),

        body=shinydashboard::dashboardBody(
            shinydashboardPlus::box(
                status="primary", width=12,
                shiny::actionButton("run", "Run")
            ),
            shinydashboardPlus::box(
                status="primary", width=12,
                shiny::verbatimTextOutput("progress")
            ),
            shinydashboardPlus::box(
                status="primary", width=12,
                shiny::plotOutput("result")
            )
        )
    )

    server <- function(input, output, session) {
        observeEvent(input$run, {
            ans <- NA
            output$progress <- shiny::renderText({
                ans <<- long_run_op()
            })
            output$result <- shiny::renderPlot({
                plot(ans)
            })
        })
    }

    app <- shiny::shinyApp(ui, server)
    shiny::runApp(app, launch.browser=TRUE)

仍然在闪亮的学习曲线上，我被困在这里。有没有办法使这项工作？计算完成后，如果我能让进度条消失，加分。

EDIT2：sink 有帮助吗？有没有办法在 Shiny 中显示 textConnection 对象？

EDIT3：我开始认为，由于 Shiny 的单线程特性，我唯一的机会是将标准输出重定向到浏览器中的某些内容。使用两个进程对我来说似乎太复杂了。

EDIT4：找到this post。似乎很可能拦截并显示消息/警告/错误，但不是cat 输出。

Answer 1

是你想要的吗？控制台上的进度条？

server <- function(input, output, session) {
  output$progress <- shiny::renderText({
    input$run
      ans <<- long_run_op()
  })
  output$result <- shiny::renderPlot({
    input$run
      plot(ans)
  })
  
}

Answer 2

因此，经过一些研究，我将我的发现发布在这里以供参考。

似乎我们无法将使用print 或cat 生成的输出重定向（“实时”）到闪亮。 （有capture.output，不过这个不适合显示进度。）

但是，我们可以为message（以及warning 和error）定义一个回调，在这个回调中我们可以更新闪亮。这甚至适用于使用Rcpp 编写的代码，有一个Rcpp::message 函数。

因此，虽然我找不到让函数 long_run_op 运行的方法，但我可以——在 keyATM 包维护者的帮助下——为keyATM::keyATM 生成一个闪亮的进度条。这是一个例子：

devtools::install_github("keyATM/keyATM", ref = "Shiny")
library(keyATM)
library(quanteda)
library(shinydashboardPlus)
data(keyATM_data_bills)
bills_keywords <- keyATM_data_bills$keywords
bills_dfm <- keyATM_data_bills$doc_dfm  
keyATM_docs <- keyATM_read(bills_dfm)

ui <- shinydashboardPlus::dashboardPage(
    header=shinydashboardPlus::dashboardHeader(),
    sidebar = shinydashboardPlus::dashboardSidebar(),

    body=shinydashboard::dashboardBody(
        shinydashboardPlus::box(
            status="primary", width=12,
            shiny::fluidRow(
                shiny::column(4,
                    shiny::numericInput('num_topics', 'New Topics', 5, min=0, max=20)
                ),
                shiny::column(4,
                    shiny::numericInput('num_iter', 'Iterations', 300, min=150, max=5000)
                ),
                shiny::column(4,
                    shiny::actionButton("run_lda", "Run keyATM")
                )
            )
        ),
        
        shinydashboardPlus::box(
            status="primary", width=12,
            shiny::plotOutput("result")
        )
    )
)

server <- function(input, output, session) {
    shiny::observeEvent(input$run_lda, {
        shiny::withProgress(
            withCallingHandlers(
                out <- keyATM(
                    docs = keyATM_docs, 
                    model = "base", 
                    no_keyword_topics = input$num_topics, 
                    keywords = bills_keywords,
                    options=list(verbose=TRUE, iterations=input$num_iter)
                ),
                message=function(m) if(grepl("^\\[[0-9]+\\]", m$message)) {
                    val <- as.numeric(gsub("^\\[([0-9]+)\\].*$", "\\1", m$message))
                    shiny::setProgress(value=val)
                }
            ),
            message="fitting model..",
            max=input$num_iter,
            value=0
        )
        output$result <- shiny::renderPlot(keyATM::plot_modelfit(out))
    })
}

app <- shiny::shinyApp(ui, server)
shiny::runApp(app, launch.browser=TRUE)