CODEWITHSUNDEEP
rshiny
Daniel Anderson
Daniel Anderson

Reputation: 2424

Writing `render*()` and `*Output()` functions for UI output in R for shiny

I am the author of the equatiomatic R package. I would like to write and export renderEq() and eqOutput() functions to make it easier to use with Shiny. Unfortunately, I can't figure it out. The below works for a basic shiny app.

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)

I'd really like to simplify this so the Ui part is just eqOutput("eq") and the server part is something like

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

I know of htmlwidgets::shinyWidgetOutput() but that doesn't seem to help in this case because I'm trying to modify a UI element.

Any help would be greatly appreciated.

Upvotes: 3

Views: 224

Answers (1)

Daniel Anderson
Daniel Anderson

Reputation: 2424

I cross posted this here and got an answer, so I'm posting it here too in case it helps others. The solution is to use the installExprFunction() and createRenderFunction() functions from shiny. These can then be wrapped in its own render function, as follows.

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)
}

And for eqOutput() it's just

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

So the full example, ensuring that it renders properly both ways, is

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)

Upvotes: 2

Related Questions