在 Shiny 中显示文本进度条

Question

所以我想为一个 long-运行函数 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。这只会显示 return 值。此外，服务器功能使用 <<-，这不仅闻起来像不好的做法，甚至不起作用——情节从未显示。

（编辑：未显示的情节是因为 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 的单线程特性，我唯一的机会就是将 stdout 重定向到浏览器中的某些内容。使用两个进程对我来说太复杂了。

EDIT4：找到 this post。似乎很可能拦截并显示 messages/warning/errors，但不是 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

所以经过一些研究后，我 post 我的发现在这里供参考。

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

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

因此，虽然我找不到获得函数 long_run_op 运行的方法，但在 keyATM 包维护者的帮助下，我可以在 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)

在 Shiny 中显示文本进度条

Show Text Progress Bar in Shiny

r

progress-bar

shiny