периодический захват вывода кота для блестящего вывода R (renderPrint)

Надеюсь, кто-то может помочь мне с этим.

Скажем, есть функция «пример», которая выглядит примерно так:

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

Есть ли способ периодически перехватывать выходные данные «кошки» из функции в renderPrint? Предполагая, что это длинная функция для обработки, и было бы неплохо, чтобы пользователь получил некоторую обратную связь. invalidateLater не работает для вещей, которые уже находятся внутри функции (по крайней мере, так кажется, когда я попробовал это здесь).

Кроме того, в качестве вторичной проблемы, написание кода вышеописанным образом может привести к тому, что renderPrint будет захватывать одновременно и «кошку», и data.frame, возможно, из-за «возврата».

Если бы кто-нибудь мог указать мне в правильном направлении, это было бы очень полезно! Спасибо!


r shiny shinyjs
person dlow    schedule 10.06.2014    source источник

Ответы (1)


arrow_upward
6
arrow_downward

Во-первых, отличный вопрос, я много думал об этом.

Поскольку блестящий является однопоточным, немного сложно захватить вывод функции и отобразить его в блестящем, насколько я знаю.

Обходным решением для этого может быть использование неблокирующего подключения к файлу и запуск функции, из которой вы хотите захватить выходные данные, в фоновом режиме при чтении файла для вывода функции (проверьте историю редактирования, чтобы узнать, как это сделать).

Другой способ сделать это — переопределить функцию 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)
      })
    })
  }
))

Этот пример в основном основан на этом вопрос от daattali.

person RmIu    schedule 12.10.2015
comment
Ницца; но замените shinyjs::text на shinyjs::html и текстовый аргумент на html = m$message - person Jorge Sepulveda; 22.02.2017