如何打印Shiny服务器中各个独立输出组件的源代码

首先，你的Shiny应用代码如下：

library(shiny)

ui <- fluidPage(
    titlePanel("Old Faithful Geyser Data"),

    sidebarLayout(
        sidebarPanel(
            sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30)
        ),

        mainPanel(
           plotOutput("distPlot"),
           textOutput("table")
        )
    )
)

server <- function(input, output) {

    output$distPlot <- renderPlot({
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = input$bins + 1)

        hist(x, breaks = bins, col = 'darkgray', border = 'white',
             xlab = 'Waiting time to next eruption (in mins)',
             main = 'Histogram of waiting times')
    })
    
    output$table <- renderText({
      head(faithful[, 2], 10)
    })
}

shinyApp(ui = ui, server = server)

你希望单独提取output$distPlot或output$table对应的源代码，而非整个服务器函数代码。以下是实现方法：

实现思路 #

由于server是尚未执行的函数，output只是它的形式参数，没法直接通过output$distPlot获取代码。我们需要解析服务器函数的代码体，找到对应的赋值语句，再提取右侧的表达式。

方法1：手动解析函数体 #

通过body(server)获取服务器函数的代码体，定位目标赋值语句后提取右侧代码：

# 获取server函数的代码体
server_body <- body(server)

# 提取output$distPlot对应的右侧代码
distplot_code <- server_body[[2]][[3]]
# 格式化打印代码
print(distplot_code, useSource = FALSE)

输出结果：

renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)

    hist(x, breaks = bins, col = 'darkgray', border = 'white',
         xlab = 'Waiting time to next eruption (in mins)',
         main = 'Histogram of waiting times')
})

同理，提取output$table的代码只需替换索引：

table_code <- server_body[[3]][[3]]
print(table_code, useSource = FALSE)

方法2：封装成函数自动提取 #

为了更便捷地提取任意输出组件的代码，可以封装一个工具函数：

get_output_code <- function(server_func, output_name) {
  body_expr <- body(server_func)
  # 遍历函数体内的所有语句（跳过第一个元素"{"）
  for (expr in as.list(body_expr)[-1]) {
    # 判断是否为output$xxx的赋值语句
    if (is.call(expr) && expr[[1]] == "<-" && is.call(expr[[2]]) && expr[[2]][[1]] == "$") {
      current_output <- expr[[2]][[3]]
      if (as.character(current_output) == output_name) {
        return(expr[[3]])
      }
    }
  }
  stop(paste("Output", output_name, "not found in server function"))
}

# 使用示例
# 提取distPlot的代码
print(get_output_code(server, "distPlot"), useSource = FALSE)
# 提取table的代码
print(get_output_code(server, "table"), useSource = FALSE)

运行后即可直接得到对应输出组件的源代码，完全符合你的预期格式。

内容的提问来源于stack exchange，提问作者JasonAizkalns