r语言 - 在闪亮中显示文本进度条

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)

仍然在闪亮的学习曲线上，我被困在这里。有办法解决这个问题吗?如果我能让进度条在计算完成后消失，就会得到额外的分数。

编辑2:sink会有帮助吗?是否有一种方法来显示textConnection对象在闪亮?

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

编辑4:找到这个帖子。似乎很有可能拦截并显示消息/警告/错误，但不是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生成的输出到shiny。(有capture.output，但它不适合显示进度。)

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

因此，虽然我无法找到一种方法来运行long_run_op函数，但我可以——在keyATM包维护者的帮助下——为keyATM::keyATM生成一个shiny的进度条。下面是一个例子:

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)