r - 在 Shiny 中显示文本进度条
问题描述
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 的单线程性质,我唯一的机会是将标准输出重定向到浏览器中的某些内容。使用两个过程对我来说似乎太复杂了。
EDIT4:找到这篇文章。似乎很可能拦截并显示消息/警告/错误,但不cat
输出。
解决方案
因此,经过一些研究,我在这里发布我的发现以供参考。
似乎我们无法将使用闪亮生成的输出重定向(“实时”)print
或重定向cat
到闪亮。(有capture.output
,但这不适合显示进度。)
但是,我们可以为message
(and warning
and 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)
推荐阅读
- android - Android - GoogleApiClient - 不连接片段的负载
- python - 熊猫中是否有等效的excel公式
- python - 组织循环的最佳方式是什么?
- r - 交错来自 Rcpp 中的许多对象的结果
- python - Python 3,正确调用函数
- axios - 如何传递“|” Axios URL 中的符号?
- python - 枕头坏了 - 哈希冲突::1 和 1 均为 22
- java - Java,数组返回
- node.js - 从rest api mysql验证用户
- android - XmlPullParserException:元数据不以输入法标记开头(Android 自定义键盘)