Ошибка “Объект типа ‘symbol’ не может быть подмножеством” при отображении таблицы выживаемости с gtsummary в shiny.

Я пытаюсь создать простое приложение в shiny, чтобы создать из базы данных таблицу с процентом выживаемости в определенный момент времени, сравнивая 2 группы (женщины против мужчин, препарат а против препарата б и т.д.).

Приложение имеет боковую панель с вводом (переменная времени и переменная статуса), чтобы рассчитать выживаемость. Для описательной таблицы без сравнения групп (просто выживаемость на 24 месяц в %) это работает нормально (код ниже с примером датафрейма).

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

# Создание вымышленного датафрейма
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)
)

# Определение интерфейса
ui <- fluidPage(
  navbarPage("Приложение клинических данных",
             tabPanel("Анализ выживаемости",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput("time_var", "Выберите переменную времени:",
                                      choices = names(data), selected = "OS"),
                          selectInput("status_var", "Выберите переменную статуса:",
                                      choices = names(data), selected = "status"),
                          numericInput("timepoint", "Введите момент времени:", 24, min = 1, max = 70)
                        ),
                        mainPanel(
                          tabsetPanel(
                            tabPanel("Таблица выживаемости", gt_output("surv_table"))
                          )
                        )
                      )
             )
  )
)

# Определение логики сервера
server <- function(input, output, session) {
  
  output$surv_table <- render_gt({
    # Проверка вводимых данных
    req(input$time_var, input$status_var, input$timepoint)
    
    # Создание объекта выживаемости
    surv_obj <- Surv(time = data[[input$time_var]], event = data[[input$status_var]])
    
    # Создание tbl_survival с использованием вводимых значений
    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, " месяцев вероятность выживания")),
        statistic = time ~ "{estimate}%"
      )
    
    # Преобразование в таблицу gt перед рендерингом
    gt_table <- as_gt(tbl_survival)
    
    # Отрисовка таблицы
    gt_table
  })
}

# Запуск приложения 
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 ", " месяцев вероятность выживания")),
    statistic = time ~ "{estimate}%"
  )

Проблема возникает в shiny, когда я добавляю переменную для сравнения групп (например, пол).

с этим кодом:

ui <- fluidPage(
  navbarPage("Приложение клинических данных",
             tabPanel("Анализ выживаемости",
                      sidebarLayout(
                        sidebarPanel(
                          selectInput("time_var", "Выберите переменную времени:",
                                      choices = names(data)),
                          selectInput("status_var", "Выберите переменную статуса:",
                                      choices = names(data)),
                          selectInput("group_var", "Выберите переменную группировки:",
                                      choices = c("Нет", names(data))),
                          numericInput("timepoint", "Введите момент времени:", 12, min = 1, max = 70)
                        ),
                        mainPanel(
                          tabsetPanel(
                            tabPanel("Таблица выживаемости", gt_output("surv_table"))
                          )
                        )
                      )
             )
  )
)

# Определение логики сервера
server <- function(input, output, session) {
  
  output$surv_table <- render_gt({
    # Проверка вводимых данных
    req(input$time_var, input$status_var, input$timepoint)
    
    # Создание объекта выживаемости
    surv_obj <- Surv(time = data[[input$time_var]], event = data[[input$status_var]])
    print("Объект выживаемости создан:")
    print(surv_obj)
    
    # Определение формулы группировки
    if (input$group_var == "Нет") {
      formula <- surv_obj ~ 1
    } else {
      formula <- as.formula(paste("surv_obj ~", input$group_var))
    }
    
    # Печать формулы для отладки
    print("Формула выживаемости:")
    print(formula)
    
    # Подгонка модели выживаемости с правильными данными
    fit <- survfit(formula, data = data)
    print("Модель выживаемости адаптирована:")
    print(summary(fit))
    
    # Создание tbl_survival с использованием вводимого значения
    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") |> # принуждаем сводку к "категориям"
      tbl_ard_summary(
        by = if (input$group_var == "Нет") NULL else input$group_var,
        label = list(time = paste0(input$timepoint, " месяцев вероятность выживания")),
        statistic = time ~ "{estimate}% (95% CI {conf.low}%, {conf.high}%)"
      )
    
    print("Таблица сводки:")
    print(tbl_survival)
    
    # Преобразование в таблицу gt перед рендерингом
    gt_table <- as_gt(tbl_survival)
    
    # Отрисовка таблицы
    gt_table
  })
}

# Запуск приложения 
shinyApp(ui = ui, server = server)

Я получаю ошибку “объект типа ‘symbol’ не подлежит индексации” (я пробовал множество различных альтернатив и всегда получаю одну и ту же ошибку).

При отладке формула работает нормально (summary(fit) в порядке).

Кроме того, тот же самый код в простом R (без shiny) с фиксированной переменной группировки (например, пол) работает нормально. (см. код выше)

Таким образом, проблема, вероятно, в построении таблицы с gt_summary, я предполагаю…

У вас есть какие-то идеи? Спасибо!