定期捕获猫输出以获得R闪亮输出(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中？假设这是一个很长的处理功能,用户可以获得一些feedbabk.invalidateLater不适用于已经存在于函数内的东西(至少在我在这里尝试的时候看起来那样).

另外,作为次要问题,以上述方式编写代码会导致renderPrint同时捕获"cat"和data.frame,这可能是因为"返回".

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

Answer 1

首先,很好的问题我一直在思考这个问题.

因为有光泽是单线程的,所以捕获函数输出有点棘手,并且从我所知道的内容中显示它.

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

这样做的另一种方式将是压倒一切的猫函数写入到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)
      })
    })
  }
))

这个例子主要基于daattali的这个问题.