Tristen Brush
Tristen Brush

Reputation: 1

Can I display rjags model loading text in real time in shiny?

I have a shiny app that uses an action button to run a script that executes a JAGS model (through the package rjags) on the dataset that the app user uploads. Here is my simplified script:

# SHINY SCRIPT
ui <- fluidPage(
sidebarLayout(
               sidebarPanel(
                 fileInput("data_file", "Upload File", accept = ".xlsx"),
                 actionButton("run_script", "Run Script")

server <- function(input, output, session) {
  observeEvent(input$data_file, {
    file_path(input$data_file$datapath)
  })

observeEvent(input$run_script, {
        source("model.R")
}

# MODEL SCRIPT
runModel <- function(file_path) {
#...other code...

jags_output <- jags(dat, inits, params, "model.txt", nc, ni, nb, nt)

#...more code...
}

output <- runModel(file_path)

My problem is that this model can take a really long time to run (over an hour) and the published version of my app refuses to sit idle for that long without disconnecting no matter how I change the settings. To solve this I want to show the console text that's displayed in R while the model runs in real time so that (1) the screen is updating and doesn't time-out and (2) the user can actually see the model's progress. The console text looks like this and updates continuously: loading text

I've tried adding a clock to stop the timeout, but the clock pauses while the script is running. I've seen suggestions for sink() and system() but I don't understand base R well enough to incorporate these into my code. From here (Possible to show console messages (written with `message`) in a shiny ui?) I found a promising option using withCallingHandlers:

ui <- fluidPage(
  useShinyjs(),
             sidebarLayout(
               sidebarPanel(
                 fileInput("data_file", "Upload File"),
                 actionButton("run_script", "Run Script")
               ),
               mainPanel(
                 verbatimTextOutput("model_progress")
                 )
               )
)

server <- function(input, output, session) {

  observeEvent(input$data_file, {
    file_path(input$data_file$datapath)
  })

  observeEvent(input$run_script, {
    withCallingHandlers({
      shinyjs::html("progress", "")
      source("model.R")
    },
    message = function(m){
      shinyjs::html(id="progress", html = m$message, add=T)
    })

This gives me console messages in real time, but still doesn't show the model loading messages. It seems that the model messages are a different kind of message that aren't handled by withCallingHandlers. Any guidance about how to get that loading bar shown in shiny in real time?

Upvotes: 0

Views: 64

Answers (0)

Related Questions