Shiny renderPrint 不捕获所有控制台输出

Question

我正在尝试在我的 Shiny 应用程序中显示 JAGS 模型的结果。这些函数在调用时会在控制台中显示进度条。我想仅显示结果摘要，而不显示加载栏，但 renderPrint 会自动捕获控制台的所有输出。我尝试将这些函数放入单独的反应函数中，但这并没有改变结果。

我附上了一个存在此问题的示例应用程序。

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)

如果有人可以帮助我，我将非常感激。

Answer 1

您可以做很多事情：

1. 将

   progress.bar='none'

   指定为对

   update

   和

   coda.samples

   的调用（有关更多详细信息，请参阅

   ?update.jags

   的帮助文件）

2. 将

   library(rjags)

   调用包装在

   suppressPackageStartupMessages(library(rjags))

   中以停止那里发生的任何输出

3. 使用

   capture.output

   手动捕获/吞咽输出（尽管这不是必需的）。

希望有帮助！

马特