如何使UI响应for循环中的反应性值? [英] How can I make UI respond to reactive values in for loop?
问题描述
我正在制作一个闪亮的应用程序，它可以从文件中读取，进行一些处理并在UI中生成表.问题在于文件可能很大，并且分析速度很慢，因此处理表可能需要很长时间(通常是几分钟，可能是半小时).我想显示一个部分表，并在每次计算新行时将其添加到其中，以便用户可以在生成数据时看到它们.
我正在使用反应值来存储数据以创建表，然后使用renderTable()渲染表
下面是该问题的说明(出于清洁原因，这不是我的实际代码，但可以作为说明)
库(发光)ui<-fluidPage(titlePanel("title")，sidebarLayout(sidebarPanel(actionButton(inputId ="button"，label ="make table"))，mainPanel(uiOutput("table"))))makeTable<-function(rv){数据= c(1:10)withProgress({for(1:5中的i){d = 运行(10)数据= rbind(数据，d)Sys.sleep(1)rv $ table =数据incProgress(1/5)}})rv $ table =数据}服务器<-功能(输入，输出){rv = reactValues(表= c())watchEvent(input $ button，{makeTable(rv)})output $ table = renderTable(rv $表)}ShinyApp(用户界面，服务器) 我放入了sys.sleep(1)，以便在5秒钟内建立该表.当前，尽管rv $ data =数据出现在for循环内，但直到整个过程完成后才显示该表.有没有办法修改上面的代码，以便每秒添加表的行(由for循环的每次迭代生成)，而不是最后添加所有行?
我应该说清楚文件是快速读入的(在按下make table按钮之前)，长部分是for循环内部的处理(这取决于文件的大小).我没有读取或写入文件的麻烦-我想知道是否存在一种方法可以在for循环内分配rv $ table = data，并在循环仍在运行时将更改反映在UI中(以及一般而言，如何使循环中的任意UI和反应性值具有这种行为)
我会从闪亮的应用程序中分离处理部分，以使其保持响应状态(R是单线程的).
这里是一个示例，该示例在通过 library(callr)创建的后台R进程中连续写入文件.然后，您可以通过 reactiveFileReader 读取文件的当前状态.
如果要按会话开始文件处理，只需将 r_bg()调用放在 server 函数内部(请参阅我的评论).此外，当前的处理是逐行进行的.在您的实际代码中，您应该考虑分批处理数据(n行，对于您的代码而言是合理的)
库(发光)图书馆(来电者)processFile<-function(){文件名<-"output.txt"if(！file.exists(filename)){file.create(文件名)}for(我在1:24中){d =符文(1)Sys.sleep(.5)write.table(d，file =文件名，append = TRUE，row.names = FALSE，col.names = FALSE)}返回(NULL)}#启动后台R会话-----------------------------------------------rx<-r_bg(processFile)#创建闪亮的应用程序--------------------------------------------------------ui<-fluidPage(titlePanel("reactiveFileReader")，sidebarLayout(sidebarPanel()，mainPanel(uiOutput("table"))))服务器<-功能(输入，输出，会话){#rx<-r_bg(processFile)#如果您想以会话方式启动文件处理readOutput<-函数(文件){if(file.exists(file)){tableData<-tryCatch({read.table(file)}，error = function(e){e})如果(inherits(tableData，'error')){tableData = NULL} 别的 {tableData}} 别的 {tableData = NULL}}rv<-reactFileReader(intervalMillis = 100，会话，filePath ="output.txt"，readFunc = readOutput)output $ table = renderTable({rv()})session $ onSessionEnded(function(){file.remove("output.txt")})}ShinyApp(用户界面，服务器) 作为一种替代方法，我建议使用库(
使用 library(promises)的结果:(由@ antoine-sac编码)-阻止了闪亮的会话
这是利用 library(ipc)的另一种方法这样可以避免使用 reactiveFileReader ，因此代码中不需要文件处理:
库(发光)图书馆(ipc)图书馆(未来)库(data.table)计划(多进程)ui<-fluidPage(titlePanel(进程间通信")，sidebarLayout(侧边栏面板(textOutput("random_out")，p()，actionButton('run'，'开始处理'))，mainPanel(tableOutput(结果"))))服务器<-功能(输入，输出){队列<-ShinyQueue()队列$消费者$开始(100)result_row<-reactVal()watchEvent(input $ run，{未来({for(1:10中的i){Sys.sleep(1)结果<-data.table(t(runif(10，1，10)))queue $ producer $ fireAssignReactive("result_row"，结果)}})空值})resultDT<-reactVal(值= data.table(NULL))watchEvent(result_row()，{resultDT(rbindlist(list(resultDT()，result_row())))})随机<-反应性({invalidateLater(200)符文(1)})输出$ random_out<-renderText({paste(并行运行的东西"，random())})output$result <- renderTable({req(resultDT())})}ShinyApp(ui = ui，服务器=服务器) 为整理我与@ antoine-sac的讨论以供将来的读者使用:在使用他的代码的机器上，我的确在长时间运行的代码(睡眠时间)和被阻止的UI之间经历了直接的互连:
但是，这样做的原因并不是分叉成本更高，具体取决于操作系统还是使用@ antoine-sac所述的docker-问题是缺少可用的工人.如?multiprocess 中所述:
workers:正数标量或指定函数的函数可以同时处于活动状态的最大并行期货数量在阻止之前.
默认值是通过 availableCores()确定的-尽管在Windows计算机上， plan(multiprocess)默认是多会话评估.
因此，讨论是由缺乏配置以及由于底层硬件而使用的不同默认值引发的.
以下是用于复制gif的代码(基于@ antoine-sac的第一篇贡献):
库(发光)图书馆(未来)图书馆(应许)计划(多进程)#计划(多进程(工人= 10))ui<-fluidPage(titlePanel("title")，sidebarLayout(sidebarPanel(p(textOutput("random"))，p(numericInput("sleep"，"Sleep time"，value = 5))，p((actionButton(inputId ="button"，label ="make table")))，htmlOutput("info"))，mainPanel(uiOutput("table"))))makeTable<-函数(行，输入){文件名<-tempfile()file.create(文件名)为(i in 1:nrow){未来({#这里的操作昂贵Sys.sleep(隔离(input $ sleep))矩阵(c [i，符(10))，nrow = 1)})％...>％as.data.frame()％...>％readr :: write_csv(path =文件名，append = TRUE)}reactFileReader(intervalMillis = 100，会话= NULL，filePath =文件名，readFunc = readr :: read_csv，col_names = FALSE)}服务器<-功能(输入，输出，会话){TimingInfo<-reactVal()output $ info<-renderUI({TimingInfo()})output $ random<-renderText({invalidateLater(100)paste(并行运行的东西:"，runif(1))})table_reader<-eventReactive(input $ button，{开始<-Sys.time()结果<-makeTable(10，输入)结束<-Sys.time()持续时间<-结束开始duration_sleep_diff<-持续时间输入$ sleepTimingInfo(p("start:"，start，br()，"end:"，end，br()，"duration:"，duration，br()，"duration-sleep"，duration_sleep_diff))返回(结果)})output $ table = renderTable(table_reader()())#嵌套的反应式，double()}ShinyApp(用户界面，服务器) I'm making a shiny app which reads from a file, does some processing, and produces a table in the UI. The problem is that the file may be very big, and the analysis is slow, so processing the table may take a long time (often several minutes, possibly half an hour). I would like to display a partial table, and add to it every time a new row has been computed so that the user can see the data as it is generated.
I'm using a reactive value to store the data to make the table, and then rendering the table using renderTable()
below is an illustration of the problem (it's not my actual code for cleanliness reasons, but it works as an illustration)
library(shiny)
ui <- fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(
actionButton(inputId = "button", label = "make table")
),
mainPanel(
uiOutput("table")
)
)
)
makeTable <- function(rv){
data = c(1:10)
withProgress({
for(i in 1:5){
d = runif(10)
data = rbind(data, d)
Sys.sleep(1)
rv$table = data
incProgress(1/5)
}
})
rv$table = data
}
server <- function(input, output){
rv = reactiveValues(table = c())
observeEvent(input$button, {
makeTable(rv)
})
output$table = renderTable(
rv$table
)
}
shinyApp(ui, server)
I put sys.sleep(1) so that the table is built over 5 seconds. Currently, despite rv$data = data appearing inside the for loop, the table is not shown until the whole thing is finished. Is there a way to modify the code above so that the rows of the table (generated by each iteration of the for loop) are added each second, rather then all at the end?
Edit: I should have made it clear that the file is read in quickly (before the make table button is pressed), the long part is the processing inside the for loop (which depends on the size of the file). I'm not having trouble reading from or writing to files - I'm wondering if there's a way to assign rv$table = data inside the for loop, and have that change reflected in the UI while the loop is still running (and in general, how to make any arbitrary UI and reactive value in a loop behave that way)
I would detach the processing part from your shiny app, to keep it responsive (R is single threaded).
Here is an example which continuously writes to a file in a background R process created via library(callr). You can then read in the current state of the file via reactiveFileReader.
Edit: if you want to start the file processing session-wise just place the r_bg() call inside the server function (see my comment). Furthermore, the processing currently is done row-wise. In your actual code you should consider processing the data batch-wise instead (n rows, what ever is reasonable for your code)
library(shiny)
library(callr)
processFile <- function(){
filename <- "output.txt"
if(!file.exists(filename)){
file.create(filename)
}
for(i in 1:24){
d = runif(1)
Sys.sleep(.5)
write.table(d, file = filename, append = TRUE, row.names = FALSE, col.names = FALSE)
}
return(NULL)
}
# start background R session ----------------------------------------------
rx <- r_bg(processFile)
# create shiny app --------------------------------------------------------
ui <- fluidPage(
titlePanel("reactiveFileReader"),
sidebarLayout(
sidebarPanel(
),
mainPanel(
uiOutput("table")
)
)
)
server <- function(input, output, session){
# rx <- r_bg(processFile) # if you want to start the file processing session-wise
readOutput <- function(file){
if(file.exists(file)){
tableData <- tryCatch({read.table(file)}, error=function(e){e})
if (inherits(tableData, 'error')){
tableData = NULL
} else {
tableData
}
} else {
tableData = NULL
}
}
rv <- reactiveFileReader(intervalMillis = 100, session, filePath = "output.txt", readFunc = readOutput)
output$table = renderTable({
rv()
})
session$onSessionEnded(function() {
file.remove("output.txt")
})
}
shinyApp(ui, server)
As an alternative approach I'd recommend library(ipc) which lets you set up continuous communication between R processes. Also check my answer here on async progressbars.
Result using library(callr):
Result using library(promises): (code by @antoine-sac) - blocked shiny session
Edit: Here is another approach utilizing library(ipc)
This avoids using reactiveFileReader and therefore no file handling is required in the code:
library(shiny)
library(ipc)
library(future)
library(data.table)
plan(multiprocess)
ui <- fluidPage(
titlePanel("Inter-Process Communication"),
sidebarLayout(
sidebarPanel(
textOutput("random_out"),
p(),
actionButton('run', 'Start processing')
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
queue <- shinyQueue()
queue$consumer$start(100)
result_row <- reactiveVal()
observeEvent(input$run,{
future({
for(i in 1:10){
Sys.sleep(1)
result <- data.table(t(runif(10, 1, 10)))
queue$producer$fireAssignReactive("result_row", result)
}
})
NULL
})
resultDT <- reactiveVal(value = data.table(NULL))
observeEvent(result_row(), {
resultDT(rbindlist(list(resultDT(), result_row())))
})
random <- reactive({
invalidateLater(200)
runif(1)
})
output$random_out <- renderText({
paste("Something running in parallel", random())
})
output$result <- renderTable({
req(resultDT())
})
}
shinyApp(ui = ui, server = server)
To clean up the discussion I've had with @antoine-sac for future readers: On my machine using his code I was indeed experiencing a direct interconnection between the long running code (sleep time) and the blocked UI:
However, the reason for this was not that forking is more expensive depending on the OS or using docker as @antoine-sac stated - the problem was a lack of available workers. As stated in ?multiprocess:
workers: A positive numeric scalar or a function specifying the maximum number of parallel futures that can be active at the same time before blocking.
The default is determined via availableCores() - although on a windows machine plan(multiprocess) defaults to multisession evaluation.
Accordingly the discussion was triggered by a lack of configuration and different defaults used due to the underlying hardware.
Here is the code to reproduce the gif (based on @antoine-sac's first contribution):
library(shiny)
library(future)
library(promises)
plan(multiprocess)
# plan(multiprocess(workers = 10))
ui <- fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(
p(textOutput("random")),
p(numericInput("sleep", "Sleep time", value = 5)),
p((actionButton(inputId = "button", label = "make table"))),
htmlOutput("info")
),
mainPanel(
uiOutput("table")
)
)
)
makeTable <- function(nrow, input){
filename <- tempfile()
file.create(filename)
for (i in 1:nrow) {
future({
# expensive operation here
Sys.sleep(isolate(input$sleep))
matrix(c(i, runif(10)), nrow = 1)
}) %...>%
as.data.frame() %...>%
readr::write_csv(path = filename, append = TRUE)
}
reactiveFileReader(intervalMillis = 100, session = NULL,
filePath = filename,
readFunc = readr::read_csv, col_names = FALSE)
}
server <- function(input, output, session){
timingInfo <- reactiveVal()
output$info <- renderUI({ timingInfo() })
output$random <- renderText({
invalidateLater(100)
paste("Something running in parallel: ", runif(1))
})
table_reader <- eventReactive(input$button, {
start <- Sys.time()
result <- makeTable(10, input)
end <- Sys.time()
duration <- end-start
duration_sleep_diff <- duration-input$sleep
timingInfo(p("start:", start, br(), "end:", end, br(), "duration:", duration, br(), "duration - sleep", duration_sleep_diff))
return(result)
})
output$table = renderTable(table_reader()()) # nested reactives, double ()
}
shinyApp(ui, server)
这篇关于如何使UI响应for循环中的反应性值?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
