r - 定期为 R Shiny 输出捕获 cat 输出(renderPrint)

Question

希望有人能帮我解决这个问题。

假设有一个函数“example”，它类似于

##function from a package

example<-function(f){
         #does something
         cat("step 1 done....")
         # etc etc
         cat("step 2 done....")
         return(some_data_frame)
}

##server ui code
example2<-reactive({
         if(input$some_action_button==0)
           return()
         result<-isolate(example(input$f1))
         return(result)
})

output$f2<-renderPrint({
         example2()
})

是否有某种方法可以定期将函数的“cat”输出捕获到 renderPrint 中？假设这是一个很长的函数来处理，并且用户得到一些反馈会很好。 invalidateLater 对已经在函数中的东西不起作用(至少当我在这里尝试时看起来是这样)。

此外，作为次要问题，以上述方式编写代码会导致 renderPrint 同时捕获“cat”和 data.frame，可能是因为“返回”。

如果有人能指出我正确的方向，那将是最有帮助的!谢谢!

Answer 1

首先，一个很好的问题，我一直在思考这个问题。

由于 Shiny 是单线程的，因此根据我的了解，捕获函数输出并以 Shiny 的形式显示它有点棘手。

解决此问题的方法是使用非阻塞文件连接并在读取函数输出的文件时运行要在后台捕获输出的函数(检查编辑历史记录以了解如何执行此操作)。

另一种方法是覆盖 cat 函数以写入 stderr(只需将 cat 切换为 message )并像这样捕获函数输出:

library(shiny)
library(shinyjs)

myPeriodicFunction <- function(){
  for(i in 1:5){
    msg <- paste(sprintf("Step %d done.... \n",i))
    cat(msg)
    Sys.sleep(1)
  }
}

# Override cat function
cat <- message

runApp(shinyApp(
  ui = fluidPage(
    shinyjs::useShinyjs(),
    actionButton("btn","Click me"),
    textOutput("text")
  ),
  server = function(input,output, session) {
    observeEvent(input$btn, {
      withCallingHandlers({
        shinyjs::text("text", "")
        myPeriodicFunction()
      },
      message = function(m) {
        shinyjs::text(id = "text", text = m$message, add = FALSE)
      })
    })
  }
))

这个例子主要基于 this daattali 提出的问题。