Reputation: 2424
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
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