Reputation: 547
I'm attempting to made reactive labels for my summary table. I'm making a reactive regression model and then I'm pulling that data frame out of the model and using that to make my summary table using gtsummary::tbl_summary() which outputs prettier tables than stargazer imo.
tbl_summary takes a list formatted like variable ~ "variable name". I'm using if statements to check that the variable name exists in the df and if it does, it appends it to the temporary variable covars which ultimately makes up the reactive variable covar.labels. covar.labels should ultimately have a list of formulas formatted as variable ~ "variable name" which will define the labels for my summary table if and only if they actually exist in the regression model.
Data: https://pastebin.com/kjAynKNH
I tested this first outside of Shiny and the following code works:
library(shiny)
library(gtsummary)
library(gt)
library(readr)
library(dplyr)
model_data <- read_csv("model_df.csv")
model <- lm(perc_suspensions ~ Thefts, data=model_data)
covars <- vector()
if ('perc_suspensions' %in% colnames(model$model)){
covars <- c(covars, perc_suspensions ~ 'perc_suspensions Test')
}
if ('Thefts' %in% colnames(model$model)){
covars <- c(covars, Thefts ~ 'Thefts Test')
}
tbl_summary(model$model,
label = covars) %>%
as_gt()
It outputs this:
So attempted it with Shiny:
library(shiny)
library(gtsummary)
library(gt)
library(readr)
library(dplyr)
#Server
# Loading in my dataframe
data <- read_csv("model_df.csv")
server <- function(input, output) {
regFormula <- reactive({
as.formula(paste("perc_suspensions", " ~ ", paste(input$iv1, collapse = "+")))
}) #reactive for linear regression
# then, put that formula into lm() for a linear regression
model <- reactive({
lm(regFormula(), data)
})
covar.label <- reactive({
covars <- vector()
if ('perc_suspensions' %in% colnames(model()$model)){
covars <- c(covars, perc_suspensions ~ 'perc_suspensions Test')
}
if ('Thefts' %in% colnames(model()$model)){
covars <- c(covars, Thefts ~ 'Thefts Test')
}
covars
})
#Create nice regression table output
#stargazer() comes from the stargazer package
output$regTab <- renderText(
{
stargazer(model(), type="html")
} # stargazer render
)
# Summary table
output$summary <- render_gt(
{
tbl_summary(model()$model,
label = covar.label) %>%
as_gt()
}
)
}
ui <- shinyUI(fluidPage(
navbarPage("Final Exam App",
tabPanel(
"Tab Panel PlaceHolder ",
headerPanel("Header Panel PlaceHolder"),
sidebarLayout(
position = "right",
sidebarPanel(
width=3,
h2("Build your model"),
br(),
checkboxGroupInput(
"iv1",
label = "Select any of the independent variables below to calculate your model. You can change your selection at any time.",
c("Thefts per 100 students" = "Thefts")
) # checkboxGroupInput
), #sidebarpanel
mainPanel(
width = 9,
br(),
fluidRow(
h3("Regression Table & Summary Statistics"),
HTML('</br>'),
splitLayout(cellWidths = c("55%", "45%"),
cellArgs = list(style = "padding: 6px"),
tableOutput("regTab"),
gt_output("summary")),
HTML('</br>')), #fluidrow
HTML('</br>')
)# mainPanel
) #sidebarlayout
) # regression + df tab panel
) #navbarpg
) # fluidpage
) #shinyUI
It only outputs the error: "object of type 'closure' is not subsettable"
Any help is greatly appreciated!
Upvotes: 2
Views: 274
Reputation: 547
Final answer:
covar.label <- reactive({
covars <- vector()
if ('perc_suspensions' %in% colnames(model()$model)){
covars <- c(covars, perc_suspensions ~ 'perc_suspensions Test')
}
if ('Thefts' %in% colnames(model()$model)){
covars <- c(covars, Thefts ~ 'Thefts Test')
}
covars
})
output$summary <- render_gt(
{
covars <- covar.label()
tbl_summary(model()$model,
label = covars) %>%
as_gt()
}
)
The trick here was to take the covar.label reactive variable and the place it in the covars variable within the render_gt.
Upvotes: 3