r - 在 R 中为 Shiny 的 UI 输出编写 `render*()` 和 `*Output()` 函数

Question

我是 equatiomatic 的作者R包。我想编写并导出 renderEq() 和 eqOutput() 函数，使其更易于与 Shiny 一起使用。不幸的是，我无法弄清楚。以下适用于基本的 Shiny 应用。

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(equatiomatic)
library(gtsummary)
library(gt)

ui <- fluidPage(
  titlePanel("equatiomatic w/Shiny"),
  sidebarLayout(
    sidebarPanel(
      multiInput(
        inputId = "xvars", label = "Select predictor variables :",
        choices = names(mpg)[-8],
        selected = "displ"
      )
    ),
    
    mainPanel(
      uiOutput("eq"),
      gt_output("tbl")
    )
  )
)

server <- function(input, output) {
  
  model <- reactive({
    form <- paste("hwy ~ ", paste(input$xvars, collapse = " + "))
    lm(as.formula(form), mpg)
  })
  
  output$eq <- renderUI(
    withMathJax(
      helpText(
        equatiomatic:::format.equation(
          extract_eq(model(), wrap = TRUE, terms_per_line = 3)
        )
      )
    )
  )
  
  output$tbl <- render_gt({
    as_gt(tbl_regression(model()))
  })
  
}

shinyApp(ui = ui, server = server)

我真的很想简化它，所以 Ui 部分只是 eqOutput("eq") 而服务器部分类似于

output$eq <- renderEq(
  extract_eq(model(), wrap = TRUE, terms_per_line = 3)
)

我知道 htmlwidgets::shinyWidgetOutput() 但在这种情况下这似乎没有帮助，因为我正在尝试修改 UI 元素。

如有任何帮助，我们将不胜感激。

Answer 1

我交叉发布了这个here并得到了答案，所以我也将其张贴在这里以防它对其他人有帮助。解决方案是使用来自 shiny 的 installExprFunction() 和 createRenderFunction() 函数。然后可以将它们包装在自己的渲染函数中，如下所示。

renderEq <- function(expr, env = parent.frame(), quoted = FALSE, outputArgs = list()) {
  shiny::installExprFunction(expr = expr, name = "func", eval.env = env, quoted = quoted)
  shiny::createRenderFunction(func = func, function(value, session, name, ...) {
    as.character(withMathJax(helpText(equatiomatic:::format.equation(x = value))))
  }, eqOutput, outputArgs)
}

对于 eqOutput() 就是

eqOutput <- function(outputId) {
  shiny::htmlOutput(outputId = outputId)
}

所以完整的例子，确保它正确地呈现两种方式，是

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(equatiomatic)
library(gtsummary)
library(gt)

renderEq <- function(expr, env = parent.frame(), quoted = FALSE, outputArgs = list()) {
  shiny::installExprFunction(expr = expr, name = "func", eval.env = env, quoted = quoted)
  shiny::createRenderFunction(func = func, function(value, session, name, ...) {
    as.character(withMathJax(helpText(equatiomatic:::format.equation(x = value))))
  }, eqOutput, outputArgs)
}

eqOutput <- function(outputId) {
  shiny::htmlOutput(outputId = outputId)
}

ui <- fluidPage(
  titlePanel("equatiomatic w/Shiny"),
  sidebarLayout(
    sidebarPanel(
      multiInput(
        inputId = "xvars", label = "Select predictor variables :",
        choices = names(mpg)[-8],
        selected = "displ"
      )
    ),
    mainPanel(
      eqOutput("eq_new"),
      uiOutput("eq"),
      gt_output("tbl")
    )
  )
)

server <- function(input, output) {
  model <- reactive({
    form <- paste("hwy ~ ", paste(input$xvars, collapse = " + "))
    lm(as.formula(form), mpg)
  })
  
  output$eq_new <- renderEq(expr = extract_eq(model(), wrap = TRUE, terms_per_line = 3))
  output$eq <- renderUI(
    withMathJax(
      helpText(
        equatiomatic:::format.equation(
          extract_eq(model(), wrap = TRUE, terms_per_line = 3)
        )
      )
    )
  )
  
  output$tbl <- render_gt({
    as_gt(tbl_regression(model()))
  })
  
}

shinyApp(ui = ui, server = server)