如何使用 gtsummary tbl_summary 使反应性协变量标签闪亮

Question

我正在尝试为我的摘要制作反应标签 table。我正在制作一个反应性回归模型，然后我将该数据框从模型中拉出并使用它来制作我的摘要 table 使用 gtsummary::tbl_summary() 输出更漂亮的 tables比 stargazer imo.

tbl_summary 采用格式类似于变量 ~“变量名称”的列表。我正在使用 if 语句来检查变量名是否存在于 df 中，如果存在，它将它附加到最终构成反应变量 covar.labels 的临时变量 covars。 covar.labels 最终应该有一个格式为变量 ~“变量名称” 的公式列表，当且仅当它们确实存在于回归模型中时，它将为我的摘要定义标签 table。

数据：https://pastebin.com/kjAynKNH

我首先在 Shiny 之外测试了这个，下面的代码有效：

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

它输出这个：

所以尝试使用 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

它只输出错误：“'closure' 类型的对象不是子集table”

非常感谢任何帮助！

Answer 1

最终答案：

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

这里的技巧是获取 covar.label 反应变量并将其放置在 render_gt.

中的 covars 变量中

如何使用 gtsummary tbl_summary 使反应性协变量标签闪亮

How to make reactive covariate labels in shiny with gtsummary tbl_summary

r

shiny

gtsummary