使用闪亮的 gtsummary 渲染生存表时出现“‘symbol’类型的对象不可取子集”错误

问题描述 投票：0回答：1

我正在尝试用闪亮的语言构建一个简单的应用程序，从数据库创建一个表，其中包含某个时间点的生存率％，比较两组（女性与男性，药物a与药物b等）。

该应用程序有一个侧边栏，其中包含用于计算生存的输入（时间变量和状态变量）。对于没有组比较的描述性表格（仅 24 个月的生存率，以 % 表示），效果很好（下面的代码和数据框示例）。

library(shiny)
library(gtsummary)
library(survival)
library(dplyr)
library(DT)
library(cards)
library(cardx)
library(gt)

# Create a made-up dataframe
set.seed(123)
data <- data.frame(
  gender = sample(c("male", "female"), 100, replace = TRUE),
  age = sample(18:70, 100, replace = TRUE),
  stage = sample(1:4, 100, replace = TRUE),
  OS = runif(100, 2, 70),
  status = sample(0:1, 100, replace = TRUE),
  ECOG24 = sample(0:1, 100, replace = TRUE)
)

# Define UI
ui <- fluidPage(
  navbarPage("Clinical Data App",
             tabPanel("Survival Analysis",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput("time_var", "Select Time Variable:",
                                      choices = names(data), selected = "OS"),
                          selectInput("status_var", "Select Status Variable:",
                                      choices = names(data), selected = "status"),
                          numericInput("timepoint", "Enter Timepoint:", 24, min = 1, max = 70)
                        ),
                        mainPanel(
                          tabsetPanel(
                            tabPanel("Survival Table", gt_output("surv_table"))
                          )
                        )
                      )
             )
  )
)

# Define server logic
server <- function(input, output, session) {
  
  output$surv_table <- render_gt({
    # Validate inputs
    req(input$time_var, input$status_var, input$timepoint)
    
    # Create survival object
    surv_obj <- Surv(time = data[[input$time_var]], event = data[[input$status_var]])
    
    # Build tbl_survival using the input values
    tbl_survival <- 
      survfit(surv_obj ~ 1, data) |> 
      cardx::ard_survival_survfit(times = c(input$timepoint)) |>  
      cards::update_ard_fmt_fn(
        stat_names = c("estimate", "conf.low", "conf.high"),
        fmt_fn = label_style_sigfig(digits = 2, scale = 100)
      ) |> 
      tbl_ard_summary(
        label = list(time = paste0(input$timepoint, " months Survival Probability")),
        statistic = time ~ "{estimate}%"
      )
    
    # Convert to gt table before rendering
    gt_table <- as_gt(tbl_survival)
    
    # Render the table
    gt_table
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

我期待使用此代码创建一个表：

survfit(Surv(OS, status) ~ gender, data) |> 
  cardx::ard_survival_survfit(times = c(24)) |>  
  cards::update_ard_fmt_fn(
    stat_names = c("estimate", "conf.low", "conf.high"),
    fmt_fn = label_style_sigfig(digits = 2, scale = 100)
  ) |> 
  tbl_ard_summary(
    by = gender,
    label = list(time = paste0("24 ", " months Survival Probability")),
    statistic = time ~ "{estimate}%"
  )

当我添加一个变量来比较组（例如性别）时，问题就很明显了。

使用此代码：

ui <- fluidPage(
  navbarPage("Clinical Data App",
             tabPanel("Survival Analysis",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput("time_var", "Select Time Variable:",
                                      choices = names(data)),
                          selectInput("status_var", "Select Status Variable:",
                                      choices = names(data)),
                          selectInput("group_var", "Select Grouping Variable:",
                                      choices = c("None", names(data))),
                          numericInput("timepoint", "Enter Timepoint:", 12, min = 1, max = 70)
                        ),
                        mainPanel(
                          tabsetPanel(
                            tabPanel("Survival Table", gt_output("surv_table"))
                          )
                        )
                      )
             )
  )
)

# Define server logic
server <- function(input, output, session) {
  
  output$surv_table <- render_gt({
    # Validate inputs
    req(input$time_var, input$status_var, input$timepoint)
    
    # Create the survival object
    surv_obj <- Surv(time = data[[input$time_var]], event = data[[input$status_var]])
    print("Survival Object Created:")
    print(surv_obj)
    
    # Determine grouping formula
    if (input$group_var == "None") {
      formula <- surv_obj ~ 1
    } else {
      formula <- as.formula(paste("surv_obj ~", input$group_var))
    }
    
    # Print the formula for debugging
    print("Survival Formula:")
    print(formula)
    
    # Fit the survival model with the correct data
    fit <- survfit(formula, data = data)
    print("Survival Model Fitted:")
    print(summary(fit))
    
    # Build tbl_survival using the input value
    tbl_survival <- 
      fit |> 
      cardx::ard_survival_survfit(times = input$timepoint) |> 
      cards::update_ard_fmt_fn(
        stat_names = c("estimate", "conf.low", "conf.high"),
        fmt_fn = label_style_sigfig(digits = 2, scale = 100)
      ) |> 
      dplyr::mutate(context = "categorical") |> # forcing the summary to a "category-like" format
      tbl_ard_summary(
        by = if (input$group_var == "None") NULL else input$group_var,
        label = list(time = paste0(input$timepoint, " months Survival Probability")),
        statistic = time ~ "{estimate}% (95% CI {conf.low}%, {conf.high}%)"
      )
    
    print("Summary Table:")
    print(tbl_survival)
    
    # Convert to gt table before rendering
    gt_table <- as_gt(tbl_survival)
    
    # Render the table
    gt_table
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

我收到错误“‘symbol’类型的对象不可取子集”（我尝试了许多不同的替代方案，但总是出现相同的错误）。

调试时，公式运行良好（summary(fit) 就可以了）。

此外，使用固定分组变量（例如性别）在简单的 r （无光泽）中进行相同的编码，效果很好。 （见上面的代码）

所以，问题应该出在使用 gt_summary 构建表时，我认为......

你有什么想法吗？谢谢！

r shiny gtsummary survival
1个回答
0
投票

您可以将错误跟踪到这部分：

fit |> 
  cardx::ard_survival_survfit(times = c(24))

您可以使用 Shiny 输入来创建 

formula
对象，并传递给 
survfit
函数来创建 
fit
对象。该对象创建时没有错误，但它包含一个包含公式的“call”元素，如下所示：

str(fit$call)
# language survfit(formula = formula, data = data)

然后，

cardx
/
cards
函数使用这个“调用”元素来计算进一步的估计，但它无法找到真正的公式。

如果您从以下拟合中查看“call”元素，直接创建而无需变量/输入（就像在第二个代码块中一样），整个公式就在那里：

fit2 <- survfit(Surv(OS, status) ~ gender, data)
str(fit2$call)
# language survfit(formula = Surv(OS, status) ~ gender, data = data)

因此，我们需要一种方法来使用从输入变量动态生成的公式创建 

fit
对象，然后将整个公式传递到 
fit$call
元素中。我可以通过使用 
quote()
、
deparse()
和 
deparse1()
函数重新创建公式并将其替换为 
fit$call
元素中的 
call
对象来完成此操作：

# don't create the surv_obj object yet
 surv_obj <- quote(Surv(time = data[[input$time_var]], event = data[[input$status_var]]))

    # Determine grouping formula
    if (input$group_var == "None") {
      formula <- as.formula(paste0(deparse(surv_obj), "~ gender"))
    } else {
      formula <- as.formula(paste0(deparse(surv_obj), "~", input$group_var))
    }
    
    # Print the formula for debugging
    print("Survival Formula:")
    print(formula)
    
    # Fit the survival model with the correct data
    fit <- survfit(formula = formula, data = data)
    formula2 = deparse1(formula)
    fit$call <- as.call(str2lang(paste("survfit(formula = ", formula2, ", data = data)")))
    print("Survival Model Fitted:")
    print(summary(fit))

然后 

cardx::ard_survival_survfit()
函数不会显示任何错误，并且您的应用程序运行良好！

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.