Shiny renderPrint don't capture all console output

Question

I am trying to display the results from a JAGS model in my Shiny app. The functions show a progress bar in the console when called. I would like to display a summary of the results only and not the loading bars, but renderPrint automatically captures all output to the console. I tried putting the functions into separate reactive functions, but it doesn't change the outcome.

I attached an example app that has this problem.

library(shiny)
library(tidyr)
library(dplyr)
library(DT)
library(rjags)

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("App"),

    sidebarLayout(
        sidebarPanel(
          checkboxGroupInput("studies", "Studies to include:",
                             c("A", "B", "C", "D", "E", "F", "G", "H"), selected = c("A", "B", "C", "D", "E", "F", "G", "H"))
        ),

        mainPanel(
          verbatimTextOutput("summary")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  data_lumped <- data.frame(
    study = c("A", "B", "C", "D", "E", "F", "G", "H"),
    Drug1 = c(2, 2, 2, 3, 5, 4, 4, 4),
    n1 = c(2700, 3500, 50, 40, 400, 160, 70, 10),
    mean1 = c(0.65, 0.71, 0.77, 0.8, 0.63, 0.87, 0.67, 0.91),
    sd1 = c(1.31, 0.76, 3.22, 0.54, 0.66, 1.07, 0.61, 0.42),
    Drug2 = c(1, 1, 1, 4, 2, 1, 1, 1),
    n2 = c(2700, 3500, 60, 40, 6000, 150, 70, 10),
    mean2 = c(0.95, 0.93, 1.04, 0.66, 0.69, 1.1, 1.03, 1.05),
    sd2 = c(1.3, 0.7, 2.5, 0.5, 0.8, 0.9, 0.94, 0.1)
  )
  
  data.lumped <- reactive({
    
    data <- data_lumped %>% filter(study %in% input$studies)
    ns <- length(data$study)
    list(m = structure(.Data = c(data$mean1, data$mean2 ),
                       .Dim = c(ns, 2)),
         e = structure(.Data = c(data$sd1/sqrt(data$n1), data$sd2/sqrt(data$n2)),
                       .Dim = c(ns, 2)),
         ns = ns,
         na = rep(2, ns),
         nt = 5,
         t = structure(.Data = c(data$Drug1, data$Drug2),
                       .Dim = c(ns, 2)), 
         maxarms = 2
    )
  })

  output_bayes <- reactive({

        ns <- data.lumped()$ns
        init <-list(list(d = c(NA, rep(0,4)), sd = 0.1, mu = rep(0, ns)),
                    list(d = c(NA, rep(1,4)), sd = 0.5, mu = rep(-1, ns)),
                    list(d = c(NA, rep(-1,4)), sd = 0.01, mu = rep(1, ns)))
        modelstring = "
    model{

    # setting values for baseline in contrast
    d[1] <- 0
    tau <- pow(sd, -2)

    # setting prior for mu, delta, d, and sd
    sd ~ dunif(0,5)


    # treatment specific priors
    for(k in 2:nt){
      d[k] ~ dnorm(0, 0.0001)
    }

    for(i in 1:ns){
    # study-specific inital values
      delta[i,1] <- 0
      w[i,1] <- 0
    # prior for study-specific parameters
      mu[i] ~ dnorm(0, 0.0001)

    for(k in 1:na[i]){ # per study-specific trial-arm k
          theta[i, k] <- mu[i] + delta[i, k]
          m[i, k] ~ dnorm(theta[i, k], prec[i, k])
          prec[i, k] <- 1 / (e[i, k] * e[i, k])

          dev[i,k] <- (m[i,k]-theta[i,k])*(m[i,k]-theta[i,k])*prec[i,k] #Deviance contribution

    }
    resdev[i] <- sum(dev[i, 1:na[i]])

    for(k in 2:na[i]){
      delta[i,k] ~ dnorm(md[i,k], taud[i,k])
      md[i,k] <- d[t[i,k]] - d[t[i,1]] + sw[i,k]
      taud[i,k] <- tau*2*(k-1)/k
      w[i,k] <- (delta[i,k] - d[t[i,k]] + d[t[i,1]])
      sw[i,k] <- sum(w[i, 1:(k-1)])/(k-1)
    }

    }
    totresdev <-  sum(resdev[])
    meanmu <- mean(mu[])

    # Pad ragged arrays to allow them to be monitored
    for(i in 1:ns){
    for(k in (na[i]+1):maxarms){
    dev[i,k] <- 0
    rhat[i,k] <- 0
    }
    }
    }"
    model <- jags.model(textConnection(modelstring),
                        data = data.lumped(),
                        inits = init,
                        n.chains = 3,
                        n.adapt = 40000)
    update(model, n.burn = 40000)

    samples <- coda.samples(model = model,
                           variable.names = c("d[1]","d[2]", "d[3]", "d[4]",
                                              "d[5]",
                                              "sd", "totresdev"
                           ),

                           n.iter = 400000,
                           thin = 10)
    summary(samples)
      })
  
  sumtext <- reactive(
    output_bayes()
    )
  
  output$summary <- renderPrint({
    sumtext()
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

I would be very grateful if somebody could help me with this.

Answer 1

There are a number of things you could do:

1. Specify progress.bar='none' to the calls to update and coda.samples (see the help file for ?update.jags for more details on that)

2. Wrap the library(rjags) call in suppressPackageStartupMessages(library(rjags)) to stop any output occurring there

3. Use capture.output to capture/swallow the output manually (although this should not be necessary).

Hope that helps!

Matt