Я бы отсоединил обрабатывающую часть от вашего блестящего приложения, чтобы она оставалась отзывчивой (R однопоточен).
Вот пример, который непрерывно записывает в файл в фоновом R-процессе, созданном с помощью library(callr). Затем вы можете прочитать текущее состояние файла через reactiveFileReader.
Редактировать: если вы хотите начать обработку файлов по сеансам, просто поместите вызов r_bg() внутри функции server (см. Мой комментарий). Кроме того, обработка в настоящее время выполняется построчно. В вашем реальном коде вы должны вместо этого обрабатывать данные в пакетном режиме (n строк, что всегда приемлемо для вашего кода)
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)
В качестве альтернативного подхода я бы порекомендовал библиотеку ( ipc ), которая позволяет настроить непрерывную связь между процессами R. Также проверьте мой ответ здесь на асинхронных индикаторах выполнения.
Результат с использованием library(callr):
Результат с использованием library(promises): (код @ antoine-sac) - заблокированный блестящий сеанс
Редактировать: вот еще один подход, использующий library(ipc)
Это позволяет избежать использования reactiveFileReader и, следовательно, в коде не требуется обработка файлов:
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)
Чтобы очистить обсуждение, которое я имел с @ antoine-sac для будущих читателей:
На моей машине, использующей его код, я действительно испытывал прямую взаимосвязь между долго выполняющимся кодом (время ожидания) и заблокированным пользовательским интерфейсом:
Однако причина этого состояла не в том, что разветвление обходится дороже в зависимости от ОС или использования докера, как указано @ antoine-sac, - проблема заключалась в нехватке доступных рабочих. Как указано в ?multiprocess:
работники: положительный числовой скаляр или функция, указывающая
максимальное количество параллельных фьючерсов, которые могут быть активны одновременно
до блокировки.
Значение по умолчанию определяется с помощью availableCores() - хотя на компьютере с Windows plan(multiprocess) по умолчанию используется для оценки мультисессии.
Соответственно, обсуждение было вызвано отсутствием конфигурации и другими настройками по умолчанию, используемыми из-за базового оборудования.
Вот код для воспроизведения gif (на основе первого вклада @ antoine-sac):
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)