Cattura periodicamente l'output cat per l'output R shiny (renderPrint)

Question

Spero che qualcuno possa aiutarmi con questo.

Diciamo che c'è una funzione "esempio", che è qualcosa di simile

##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() 
}) 

C'è qualche modo per catturare le uscite "gatto" dalla funzione in renderPrint, periodicamente? Supponendo che questa sia una lunga funzione da elaborare e sarebbe bello che l'utente ottenga qualche feedbabk. invalidateLater non funziona per cose che sono già all'interno di una funzione (almeno sembra così quando ho provato qui).

Inoltre, come problema secondario, la scrittura del codice nel modo precedente causerebbe il renderingPrint per catturare insieme sia "cat" che data.frame, probabilmente a causa del "ritorno".

Se qualcuno potesse indicarmi la giusta direzione, sarebbe molto utile! Grazie!

Answer 1

Prima di, ottima domanda Ho riflettuto molto su questo.

Dal momento che il lucentezza è a filettatura singola è un po 'difficile catturare l'output della funzione e visualizzarla in modo lucido da quello che so.

Un aggiramento per questo sarebbe utilizzare una connessione file non bloccante ed eseguire la funzione che si desidera catturare l'output in background mentre si legge il file per l'output della funzione (controllare la cronologia delle modifiche per vedere come eseguire questa operazione).

Un altro modo per farlo sarebbe stato ignorando la funzione gatto di scrivere su stderr (semplicemente passare cat con message) e catturare l'output funzione come questa:

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) 
     }) 
    }) 
    } 
)) 

Questo esempio si basa soprattutto sulla this domanda da daattali.