以闪亮的方式显示文本进度条

卡斯滕 W.

所以我想为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))
    }

（如果您有兴趣：我想使用 great 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帮助吗？有没有办法textConnection在 Shiny 中显示对象？

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

EDIT4：找到这篇文章。似乎很有可能拦截和显示消息/警告/错误，但不能cat输出。

卡斯滕 W.

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

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

但是，我们可以为message(andwarning和error)定义一个回调，并且在这个回调中我们可以更新 Shiny。这甚至适用于使用编写的代码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)

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。