R语言神经心理疾病预测模型NA值处理及创建失败求助

我正在为神经心理诊所构建基于认知测试数据的二分类GLM模型，用于预测患者患帕金森病或阿尔茨海默病的概率。当前核心问题：

• 患者普遍存在大量未完成测试导致的NA值，无法要求补测，且不能用常数填充（0分代表严重记忆缺陷，填充会扭曲诊断结果）
• 使用train函数训练时，默认accuracy指标因缺失值无法计算，模型无法完成训练

已尝试的解决方案 #

• 方案1：使用na.action = "na.pass"参数

model <- train(
  x = combined_data[, c("age", "hvlt_immed_total", "hvlt_delayed_recall", 
                        "hvlt_retention", "hvlt_recogn", "cvlt_tot", 
                        "cvlt_ldfr", "cvlt_recog", "wms_iv_lm1", 
                        "wms_iv_lm2", "wms_iv_lm_rec", "bvmt_immed_total", 
                        "bvmt_delayed_recall", "bvmt_retention", 
                        "bvmt_recogn", "rcf_copy", "rcf_delayed", 
                        "rcf_recogn")],
  y = combined_data$Disease,
  method = "glm",
  family = "binomial",
  trControl = ctrl,
  na.action = "na.pass"
)

• 方案2：无额外参数调用train函数

model <- train(
  x = combined_data[, c("age", "hvlt_immed_total", "hvlt_delayed_recall", 
                        "hvlt_retention", "hvlt_recogn", "cvlt_tot", 
                        "cvlt_ldfr", "cvlt_recog", "wms_iv_lm1", 
                        "wms_iv_lm2", "wms_iv_lm_rec", "bvmt_immed_total", 
                        "bvmt_delayed_recall", "bvmt_retention", 
                        "bvmt_recogn", "rcf_copy", "rcf_delayed", 
                        "rcf_recogn")],
  y = combined_data$Disease,
  method = "glm",
  family = "binomial")

• 方案3：自定义F1指标作为评估标准
  先定义自定义函数：

custom_F1 <- function(data, lev = NULL, model = NULL) {
  predictions <- predict(model, data)
  actual <- data$Disease
  cm <- confusionMatrix(predictions, actual)
  precision <- cm$byClass["Pos Pred Value"]
  recall <- cm$byClass["Sensitivity"]
  f1_score <- ifelse(precision + recall == 0, 0, 2 * (precision * recall) / (precision + recall))
  return(f1_score)
}

再调用train函数：

model <- train(
  x = combined_data[, c("age", "hvlt_immed_total", "hvlt_delayed_recall", 
                        "hvlt_retention", "hvlt_recogn", "cvlt_tot", 
                        "cvlt_ldfr", "cvlt_recog", "wms_iv_lm1", 
                        "wms_iv_lm2", "wms_iv_lm_rec", "bvmt_immed_total", 
                        "bvmt_delayed_recall", "bvmt_retention", 
                        "bvmt_recogn", "rcf_copy", "rcf_delayed", 
                        "rcf_recogn")],
  y = combined_data$Disease,
  method = "glm",
  family = "binomial",
  trControl = trainControl(method = "cv", # Cross-validation
                           summaryFunction = custom_F1, # Use custom F1 score metric
                           na.action = na.pass # Pass through NA values
                           )
)

以上方案均失败，执行后提示对象"model"不存在，无法完成模型构建。

可行解决方案 #

1. 修正自定义F1函数的NA处理逻辑 #

caret的summaryFunction要求处理预测和真实值中的NA，否则会报错。修改函数，先过滤掉含NA的样本，再计算F1：

custom_F1 <- function(data, lev = NULL, model = NULL) {
  # 过滤掉真实值或预测值含NA的样本
  valid_idx <- !is.na(data$Disease) & !is.na(predict(model, data))
  actual <- data$Disease[valid_idx]
  predictions <- predict(model, data)[valid_idx]
  
  # 处理类别水平匹配问题
  if (!all(levels(predictions) == lev)) {
    predictions <- factor(predictions, levels = lev)
  }
  
  cm <- confusionMatrix(predictions, actual, positive = lev[2])
  precision <- cm$byClass["Pos Pred Value"]
  recall <- cm$byClass["Sensitivity"]
  f1_score <- ifelse(is.na(precision) || is.na(recall) || precision + recall == 0, 
                     0, 
                     2 * (precision * recall) / (precision + recall))
  return(c(F1 = f1_score))
}

2. 让GLM自动忽略NA样本 #

GLM本身支持na.omit，但caret的train函数需要配合正确的na.action。不要用na.pass，而是设置na.action = na.omit，同时确保交叉验证时每个折都自动过滤NA：

ctrl <- trainControl(method = "cv",
                     summaryFunction = custom_F1,
                     classProbs = TRUE) # 若要计算概率需开启

model <- train(
  x = combined_data[, c("age", "hvlt_immed_total", "hvlt_delayed_recall", 
                        "hvlt_retention", "hvlt_recogn", "cvlt_tot", 
                        "cvlt_ldfr", "cvlt_recog", "wms_iv_lm1", 
                        "wms_iv_lm2", "wms_iv_lm_rec", "bvmt_immed_total", 
                        "bvmt_delayed_recall", "bvmt_retention", 
                        "bvmt_recogn", "rcf_copy", "rcf_delayed", 
                        "rcf_recogn")],
  y = combined_data$Disease,
  method = "glm",
  family = "binomial",
  trControl = ctrl,
  na.action = na.omit
)

3. 可选：使用多重插补处理NA（更严谨） #

如果不想丢弃样本，可以用mice包做多重插补，再训练模型：

library(mice)
# 多重插补，针对认知测试变量和年龄
imputed_data <- mice(combined_data[, c("age", "hvlt_immed_total", "hvlt_delayed_recall", 
                                       "hvlt_retention", "hvlt_recogn", "cvlt_tot", 
                                       "cvlt_ldfr", "cvlt_recog", "wms_iv_lm1", 
                                       "wms_iv_lm2", "wms_iv_lm_rec", "bvmt_immed_total", 
                                       "bvmt_delayed_recall", "bvmt_retention", 
                                       "bvmt_recogn", "rcf_copy", "rcf_delayed", 
                                       "rcf_recogn", "Disease")], 
                     m = 5, method = "pmm") # pmm适合连续认知测试得分

# 对每个插补数据集训练模型，再合并结果
models <- lapply(1:5, function(i) {
  dat <- complete(imputed_data, i)
  train(x = dat[, c("age", "hvlt_immed_total", "hvlt_delayed_recall", 
                    "hvlt_retention", "hvlt_recogn", "cvlt_tot", 
                    "cvlt_ldfr", "cvlt_recog", "wms_iv_lm1", 
                    "wms_iv_lm2", "wms_iv_lm_rec", "bvmt_immed_total", 
                    "bvmt_delayed_recall", "bvmt_retention", 
                    "bvmt_recogn", "rcf_copy", "rcf_delayed", 
                    "rcf_recogn")], 
        y = dat$Disease,
        method = "glm",
        family = "binomial",
        trControl = ctrl)
})

# 合并模型结果（可选，用pool函数）
pooled_model <- pool(lapply(models, function(x) x$finalModel))
summary(pooled_model)

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