异步:当 actionButton 被点击时显示进度并禁用同一用户的其他操作但允许并发用户 [英] Async: Display progress when actionButton is hit and disable other operations for the same user but allow concurrent users
问题描述
下面是一个示例代码，它接受两个输入:1) 输入文件和 2) 输入行数.单击分析"按钮后，服务器命令的输出返回到结果"选项卡集中的表".这是一个简单的示例，命令将快速执行并切换到结果"选项卡面板.
下面的withProgress代码只显示设定时间的进度条并消失，然后执行实际代码.我想在点击分析"时显示状态消息"或进度条"，并在运行命令时显示.只要进度条正在运行，当前用户(其他用户可以使用该应用程序)就无法从侧边栏中执行任何操作.因为在真正的应用程序中，侧边栏有更多的菜单项，它们执行类似的任务，每个任务都有一个 Analyze 按钮.如果允许用户浏览侧边栏页面并点击Analyze，那么应用程序将有执行多项任务的过载.理想情况下，我们应该将进度条功能与多个 actionButton 一起使用.
我阅读了有关 async 的博客，但无法将正确的代码放在正确的位置.感谢您提供任何帮助！
图书馆(闪亮)图书馆(闪亮的仪表板)侧边栏 <- 仪表板侧边栏(宽度 = 200，sidebarMenu(id = "tabs",菜单项("文件", tabName = "tab1", icon = icon("fas fa-file"))))正文 <- tabItem(tabName = "tab1",h2("输入文件"),流体行(选项卡面板(上传文件"，value = "upload_file",文件输入(inputId = "上传文件",label = "上传输入文件",倍数 = FALSE，接受 = c(".txt")),checkboxInput('header', label = 'Header', TRUE)),盒子(title = "过滤 X 行",宽度 = 7,状态 = "信息",标签集面板(id = "input_tab",选项卡面板(参数"，数字输入("nrows",label = "整个行数",值 = 5,最大值 = 10),动作按钮(运行"，分析")),选项卡面板(结果"，值 = "结果",导航栏页面(空，选项卡面板("表", DT::dataTableOutput("res_table"),icon = icon("表格"))),下载按钮(下载列表"，下载"))))))ui <-闪亮的UI(仪表板页面(仪表板标题(标题=TestApp"，标题宽度= 150)，侧边栏，仪表板Body(tabItems(body))))服务器 <- 功能(输入，输出，会话){file_rows <-reactiveVal()观察事件(输入$运行，{withProgress(session, min = 1, max = 15, {setProgress(message = '分析进行中',detail = '这可能需要一段时间...')对于(我在 1:15){设置进度(值 = i)系统睡眠(0.5)}})系统(粘贴(猫"，输入$上传文件$数据路径，"|",paste0("head -", input$nrows) ,">",输出.txt"),实习生=真)head_rows <- read.delim("out.txt")文件行(头行)})观察事件(文件行()，{updateTabsetPanel(会话，input_tab"，结果")输出$res_table <-DT::renderDataTable(DT::datatable(文件行()，选项 = 列表(搜索 = 真，页长 = 10,行名(NULL)，滚动X = T)))})output$downList <- downloadHandler(文件名 = 函数(){paste0("输出", ".txt")}, 内容 = 函数(文件){write.table(file_rows()，文件，row.names = FALSE)})}闪亮应用(用户界面 = 用户界面，服务器 = 服务器)这里是一个基于(绝对未加星标的)库的解决方案(
Below is a sample code which takes two inputs: 1) input file and 2) input number of rows. Upon clicking the "Analyze" button the output from the server command return to the "Table" in "Results" tabset. This is a simple example where the command will be executed quickly and switches to the "Results" tabsetpanel.
The below withProgress code only shows the progress bar for the set time and disappears and then the actual code is executed. I would like to show a "Status Message" or "Progress Bar" when the "Analyze" is hit and show as long as the command is run. As long as the progress bar is running the current user (other users can use the app) cannot perform any action from the side bar. Because in the real app, sidebar has more menuItems which does similar tasks like this and each task has a Analyze button. If the user is allowed to browse to sidebar pages and hit Analyze then the app will have overload of performing multiple tasks. Ideally the progress bar functionality should we used with multiple actionButtons.
I read the blogs about async but unable to put right code in the right place. any help is appreciated with a bounty!!
library(shiny)
library(shinydashboard)
sidebar <- dashboardSidebar(width = 200,
sidebarMenu(id = "tabs",
menuItem(
"File", tabName = "tab1", icon = icon("fas fa-file")
)))
body <- tabItem(tabName = "tab1",
h2("Input File"),
fluidRow(
tabPanel(
"Upload file",
value = "upload_file",
fileInput(
inputId = "uploadFile",
label = "Upload Input file",
multiple = FALSE,
accept = c(".txt")
),
checkboxInput('header', label = 'Header', TRUE)
),
box(
title = "Filter X rows",
width = 7,
status = "info",
tabsetPanel(
id = "input_tab",
tabPanel(
"Parameters",
numericInput(
"nrows",
label = "Entire number of rows",
value = 5,
max = 10
),
actionButton("run", "Analyze")
),
tabPanel(
"Results",
value = "results",
navbarPage(NULL,
tabPanel(
"Table", DT::dataTableOutput("res_table"),
icon = icon("table")
)),
downloadButton("downList", "Download")
)
)
)
))
ui <-
shinyUI(dashboardPage(
dashboardHeader(title = "TestApp", titleWidth = 150),
sidebar,dashboardBody(tabItems(body))
))
server <- function(input, output, session) {
file_rows <- reactiveVal()
observeEvent(input$run, {
withProgress(session, min = 1, max = 15, {
setProgress(message = 'Analysis in progress',
detail = 'This may take a while...')
for (i in 1:15) {
setProgress(value = i)
Sys.sleep(0.5)
}
})
system(paste(
"cat",
input$uploadFile$datapath,
"|",
paste0("head -", input$nrows) ,
">",
"out.txt"
),
intern = TRUE)
head_rows <- read.delim("out.txt")
file_rows(head_rows)
})
observeEvent(file_rows(), {
updateTabsetPanel(session, "input_tab", "results")
output$res_table <-
DT::renderDataTable(DT::datatable(
file_rows(),
options = list(
searching = TRUE,
pageLength = 10,
rownames(NULL),
scrollX = T
)
))
})
output$downList <- downloadHandler(
filename = function() {
paste0("output", ".txt")
}, content = function(file) {
write.table(file_rows(), file, row.names = FALSE)
}
)
}
shinyApp(ui = ui, server = server)
Here is a solution based on the (absolutely under-star-ed) library(ipc).
I came across this library due to a question of @Dean Attali, where Joe Cheng mentioned it.
The quick-start guide of the ipc-package gives an example of what you are asking for: AsyncProgress.
Furthermore it provides an example on how to kill a future using AsyncInterruptor.
However, I haven't been able to test it yet.
I worked around the cancel-problem by using @Dean Attali's great package shinyjs to simply start a new session and ignore the old Future (You might be able to improve this, by using AsyncInterruptor).
But nevertheless, I gave your code a Future, dropped your system() cmd because I'm currently running R on Windows and found a way to disable (tribute to @Dean Attali) the analyze button session-wise by giving it session-dependant names:
library(shiny)
library(shinydashboard)
library(ipc)
library(promises)
library(future)
library(shinyjs)
library(datasets)
library(V8)
plan(multiprocess)
jsResetCode <- "shinyjs.reset = function() {history.go(0)}"
header <- dashboardHeader(title = "TestApp", titleWidth = 150)
sidebar <- dashboardSidebar(width = 200,
sidebarMenu(id = "tabs",
menuItem(
"File", tabName = "tab1", icon = icon("fas fa-file")
)))
body <- dashboardBody(useShinyjs(),
extendShinyjs(text = jsResetCode),
fluidRow(column(
12, tabItem(
tabName = "tab1",
h2("Input File"),
textOutput("shiny_session"),
tabPanel(
"Upload file",
value = "upload_file",
fileInput(
inputId = "uploadFile",
label = "Upload Input file",
multiple = FALSE,
accept = c(".txt")
),
checkboxInput('header', label = 'Header', TRUE)
),
box(
title = "Filter X rows",
width = 7,
status = "info",
tabsetPanel(
id = "input_tab",
tabPanel(
"Parameters",
numericInput(
"nrows",
label = "Entire number of rows",
value = 5,
max = 10
),
column(1, uiOutput("sessionRun")),
column(1, uiOutput("sessionCancel"))
),
tabPanel(
"Results",
value = "results",
navbarPage(NULL,
tabPanel(
"Table", DT::dataTableOutput("res_table"),
icon = icon("table")
)),
downloadButton("downList", "Download")
)
)
)
)
)))
ui <- shinyUI(dashboardPage(
header = header,
sidebar = sidebar,
body = body,
title = "TestApp"
))
server <- function(input, output, session) {
output$shiny_session <-
renderText(paste("Shiny session:", session$token))
file_rows <- reactiveVal()
run_btn_id <- paste0("run_", session$token)
cancel_btn_id <- paste0("cancel_", session$token)
output$sessionRun <- renderUI({
actionButton(run_btn_id, "Analyze")
})
output$sessionCancel <- renderUI({
actionButton(cancel_btn_id, "Cancel")
})
paste("Shiny session:", session$token)
observeEvent(input[[run_btn_id]], {
file_rows(NULL)
shinyjs::disable(id = run_btn_id)
progress <- AsyncProgress$new(message = 'Analysis in progress',
detail = 'This may take a while...')
row_cnt <- isolate(input$nrows)
get_header <- isolate(input$header)
future({
fileCon <- file("out.txt", "w+", blocking = TRUE)
linesCnt <- nrow(iris)
for (i in seq(linesCnt)) {
Sys.sleep(0.1)
progress$inc(1 / linesCnt)
writeLines(as.character(iris$Species)[i],
con = fileCon,
sep = "\n")
}
close(fileCon)
head_rows <- read.delim("out.txt", nrows = row_cnt, header=get_header)
progress$close() # Close the progress bar
return(head_rows)
}) %...>% file_rows
return(NULL) # Return something other than the future so we don't block the UI
})
observeEvent(input[[cancel_btn_id]],{
js$reset() # reset shiny session)
})
observeEvent(file_rows(), {
shinyjs::enable(id = run_btn_id)
updateTabsetPanel(session, "input_tab", "results")
output$res_table <-
DT::renderDataTable(DT::datatable(
req(file_rows()),
options = list(
searching = TRUE,
pageLength = 10,
rownames(NULL),
scrollX = T
)
))
})
output$downList <- downloadHandler(
filename = function() {
paste0("output", ".txt")
},
content = function(file) {
write.table(file_rows(), file, row.names = FALSE)
}
)
}
shinyApp(ui = ui, server = server)
App running:
这篇关于异步:当 actionButton 被点击时显示进度并禁用同一用户的其他操作但允许并发用户的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
