R语言 如何使函数的打印结果在Shiny应用程序中对用户可见

问题描述

我正在使用pso R包中的psoptim()函数。该函数对算法的每次迭代生成一个打印结果，我希望这些输出对Shiny应用程序用户可见。

这是一个显示算法打印结果的示例：

library(pso)
psoptim(rep(NA,2),function(x) 20+sum(x^2-10*cos(2*pi*x)),lower=-5,upper=5,control=list("fnscale" = -1, "trace" = 1, "maxit" = 60, "REPORT" = 1))

这是我迄今为止尝试过的，但没有取得任何成功：

library(shiny)
library(pso)

withConsoleRedirect <- function(containerId, expr) {
  # Change type="output" to type="message" to catch stderr
  # (messages, warnings, and errors) instead of stdout.
  txt <- capture.output(results <- expr, type = "output")
  if (length(txt) > 0) {
    insertUI(paste0("#", containerId), where = "beforeEnd",
             ui = paste0(txt, "\n", collapse = "")
    )
  }
  results
}

# Example usage

ui <- fluidPage(
  actionButton("run_optim", "Run"),
  pre(id = "console")
)

server <- function(input, output, session) {
  observeEvent("run_optim",{
    #invalidateLater(1000)

    withConsoleRedirect("console", {
      psoptim(rep(NA,2),function(x) 20+sum(x^2-10*cos(2*pi*x)),lower=-5,upper=5,control=list("fnscale" = -1, "trace" = 1, "maxit" = 60, "REPORT" = 1))
    })
  })
}

shinyApp(ui, server)

解决方案

编辑 : pso::psoptim 正在使用 message(..) （基于 https://github.com/cran/pso/blob/master/R/psoptim.R#L83 ），因此我们需要告诉 capture.output 捕获消息而不是打印/输出。

请尝试这个变体：

doSomething <- function(...) message("hello world: ", sample(100, 1), "\n")
withConsoleRedirect <- function(textAreaId, expr, session = getDefaultReactiveDomain()) {
  txt <- capture.output(res <- expr, type = "message")
  if (length(txt) && any(nzchar(txt))) {
    oldtxt <- sessioninput[[textAreaId]]
    if (!nzchar(oldtxt[1])) oldtxt <- oldtxt[-1]
    updateTextAreaInput(session, textAreaId,
                        value = paste(trimws(c(oldtxt, txt)), collapse = "\n"))
  }
  res
}
library(shiny)
ui <- fluidPage(
  shinyjs::useShinyjs(),
  actionButton("btn", "Run"),
  shinyjs::disabled(textAreaInput("console", "Console", rows = 5)),
  actionButton("clr", "Clear text area")
)
server <- function(input, output, session) {
  observeEvent(inputbtn, {
    withConsoleRedirect("console", {
      doSomething()
    })
  })
  observeEvent(input$clr, {
    updateTextAreaInput(session, "console", value = "")
  })
}
shinyApp(ui, server)

在这个示例中，我建议使用一个 textarea HTML输入元素来显示文本。由于在这种情况下我不希望用户能够添加任何内容，我使用了 shinyjs 包来禁用它（不允许用户输入），尽管这不是你要求的机制所必须的。

由于这是一个始终添加的元素，我提供了清除文本区域的功能。

如果这可能是一个长时间运行的操作，很容易看出在每个消息之前添加一个时间戳（尽管在这种情况下，您可能选择使用 future 或其他后台处理能力，以便您的shiny app不会冻结）。