myfatson
myfatson

Reputation: 547

How to make reactive covariate labels in shiny with gtsummary tbl_summary

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:

enter image description here

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

Answers (1)

myfatson
myfatson

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

Related Questions