RShiny集成XGBoost生存模型报错：xgb.DMatrix不支持闭包构造

问题背景 #

开发RShiny应用运行XGBoost生存模型，需将UI分类变量转为独热编码传入模型。已创建空数据框、用响应式值调整变量并预加载模型，但运行时触发错误：xgb.DMatrix does not support construction from closure。

错误原因 #

1. 非响应式数据存储：直接使用普通数据框df存储用户输入，未用Shiny的reactiveValues管理响应式数据，导致数据更新无法触发后续计算。
2. Reactive对象调用错误：predict函数直接传入了reactive函数本身（closure），而非其返回的实际数据。
3. 数据未初始化：df未预先初始化，首次运行时为空，引发后续数据处理错误。
4. as_sgb_data参数问题：直接使用变量名作为参数，未明确引用响应式数据，可能导致数据解析错误。

修复步骤 #

• 使用reactiveValues创建响应式数据容器，替代普通数据框存储用户输入的特征。
• 在observeEvent中更新reactiveValues的内容，确保输入变化时数据同步更新。
• 让xgb_test_case依赖响应式数据，确保数据更新时重新生成符合要求的模型输入格式。
• 调用predict时，需通过()获取reactive对象的实际返回值，而非传入函数本身。
• 初始化响应式数据的默认值，避免空值问题。

修正后的完整代码 #

ui <- fluidPage(
  sidebarPanel(
    sliderInput("dxage", "Dx Age:",
                value = 65, min = 18, max = 90
    ),
    selectInput("ethnism_t", "Race/Ethnicity:",
                c("Non-Hispanic White"=1,
                  "Non-Hispanic Black"=2,
                  "Asian, Hawaiian, Pacific Islander"=3,
                  "Hispanic"=4,
                  "Other"=9)
    ), 
    actionButton("calculate", "Calculate")
  ),  
  mainPanel(
    plotOutput("survplot")
  )
)

server <- function(input, output) {
  # 初始化响应式数据容器
  rv <- reactiveValues(
    dxage = 65,
    ethnism_1 = 1,
    ethnism_2 = 0,
    ethnism_3 = 0,
    ethnism_4 = 0,
    ethnism_9 = 0,
    status = 0,
    time = 1
  )

  observeEvent(input$calculate, {
    # 更新响应式数据
    rv$dxage <- input$dxage
    rv$ethnism_1 <- ifelse(input$ethnism_t == 1, 1, 0)
    rv$ethnism_2 <- ifelse(input$ethnism_t == 2, 1, 0)
    rv$ethnism_3 <- ifelse(input$ethnism_t == 3, 1, 0)
    rv$ethnism_4 <- ifelse(input$ethnism_t == 4, 1, 0)
    rv$ethnism_9 <- ifelse(input$ethnism_t == 9, 1, 0)
    rv$status <- 0
    rv$time <- 1
  })

  # 生成模型输入数据，依赖响应式数据rv
  xgb_test_case <- reactive({
    # 将响应式值转为数据框
    df <- data.frame(
      dxage = rv$dxage,
      ethnism_1 = rv$ethnism_1,
      ethnism_2 = rv$ethnism_2,
      ethnism_3 = rv$ethnism_3,
      ethnism_4 = rv$ethnism_4,
      ethnism_9 = rv$ethnism_9,
      status = rv$status,
      time = rv$time
    )
    # 转为XGBoost生存模型要求的数据格式
    as_sgb_data(df, time = "time", status = "status")
  })

  output$survplot <- renderPlot({
    # 调用predict时获取reactive对象的实际值
    predict(fits, xgb_test_case())
  })
}

shinyApp(ui = ui, server = server)

额外优化建议 #

• 独热编码可改用model.matrix自动生成，避免手动编写多个ifelse，减少代码冗余。示例：

  # 在observeEvent中替换手动独热编码
  ethnism_df <- data.frame(ethnism_t = as.integer(input$ethnism_t))
  ethnism_encoded <- model.matrix(~ factor(ethnism_t) - 1, data = ethnism_df)
  # 将编码结果赋值给rv的对应字段
  rv$ethnism_1 <- ethnism_encoded[1, "factor(ethnism_t)1"]
  rv$ethnism_2 <- ethnism_encoded[1, "factor(ethnism_t)2"]
  # 以此类推其他类别
  

内容的提问来源于stack exchange，提问作者yussel60