R语言实现临床预测模型全流程：Logistic回归实战

宋顺宁.Seany

1. 项目概述

作为一名长期从事医学数据分析的研究者，我经常需要处理二分类结局变量的预测问题。Logistic回归作为经典的分类算法，在临床预测模型构建中扮演着重要角色。今天我要分享的是一套经过多年实战检验的R语言全流程分析代码，这套代码已经帮助我和团队完成了数十个临床研究项目的数据分析工作。

这套代码最显著的特点是实现了从原始数据到最终模型验证的完整闭环，包含数据预处理、变量筛选、模型构建和性能评估的全套解决方案。不同于零散的代码片段，这个流程经过精心设计，各模块之间无缝衔接，特别适合需要快速产出可靠结果的临床研究者使用。

重要提示：本套代码默认处理的是二分类结局变量（如生存/死亡、患病/健康），若需处理多分类问题需调整模型参数。所有示例数据均经过脱敏处理，变量名采用通用临床术语。

2. 环境准备与数据导入

2.1 软件环境配置

在开始分析前，需要确保R环境配置正确。我推荐使用R 4.0以上版本，配合RStudio作为开发环境。以下是必须安装的扩展包及其作用说明：

r复制required_packages <- c(
  "dplyr",    # 数据清洗与转换
  "VIM",      # 缺失值可视化
  "caret",    # 数据分割与模型调参
  "tableone", # 基线特征表生成
  "glmnet",   # LASSO回归实现
  "plyr",     # 数据分割与重组
  "rms",      # 回归建模与验证
  "pROC",     # ROC曲线分析
  "ggDCA",    # 决策曲线分析
  "ggprism",  # 科研级图表美化
  "ggplot2"   # 基础绘图系统
)

# 检查并安装缺失包
new_packages <- required_packages[!(required_packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages)

2.2 数据导入与预处理

数据质量直接决定模型效果。我们的标准导入流程包含三个关键步骤：

r复制# 设置工作路径（需替换为实际路径）
setwd("D:/Research/Clinical_Prediction/")

# 读取CSV数据文件
raw_data <- read.csv("patient_data.csv", stringsAsFactors = FALSE)

# 查看数据结构
str(raw_data)

对于临床数据，最常见的预处理需求是变量类型转换。以下是一个典型的转换示例：

r复制library(dplyr)

clean_data <- raw_data %>%
  transmute(
    # 将结局变量置于第一列
    Outcome = factor(Outcome, levels = c(0, 1), labels = c("No", "Yes")),
    
    # 分类变量转换
    Gender = factor(Gender, levels = c(1, 2), labels = c("Male", "Female")),
    Stage = factor(Stage, levels = 1:4, labels = c("I", "II", "III", "IV")),
    
    # 连续变量保持原样
    Age = Age,
    BMI = BMI,
    
    # 其他临床指标
    WBC = as.numeric(WBC),
    CRP = as.numeric(CRP)
  )

经验之谈：在转换分类变量时，务必确认各水平的编码与实际含义匹配。我曾遇到过一个项目因将"1=男性，2=女性"误标反而导致结果完全相反，花费两天时间才排查出问题。

2.3 缺失值处理策略

缺失数据是临床研究的常见挑战。我们采用分层处理策略：

r复制library(VIM)

# 可视化缺失模式
aggr_plot <- aggr(clean_data, 
                 numbers = TRUE, 
                 prop = TRUE,
                 labels = names(clean_data),
                 cex.axis = 0.7,
                 gap = 3)

# 缺失值处理决策流程
if(sum(is.na(clean_data)) / (nrow(clean_data)*ncol(clean_data)) < 0.05) {
  # 缺失<5%直接删除
  clean_data <- na.omit(clean_data) 
} else {
  # 重要变量缺失采用多重插补
  library(mice)
  imp <- mice(clean_data, m = 5, maxit = 50, seed = 123)
  clean_data <- complete(imp)
}

3. 数据划分与基线分析

3.1 分层随机分割

为保证训练集和测试集的代表性，我们采用基于结局变量的分层抽样：

r复制library(caret)

set.seed(2023) # 确保结果可重复
train_index <- createDataPartition(clean_data$Outcome, 
                                  p = 0.7, 
                                  list = FALSE, 
                                  times = 1)

train_data <- clean_data[train_index, ]
test_data <- clean_data[-train_index, ]

3.2 基线特征比较

生成符合临床研究规范的基线表：

r复制library(tableone)

# 指定变量类型
catVars <- c("Gender", "Stage")
contVars <- c("Age", "BMI", "WBC", "CRP")

# 创建基线表
table1 <- CreateTableOne(
  vars = c(catVars, contVars),
  strata = "Outcome", 
  data = train_data,
  factorVars = catVars
)

# 输出结果
print(table1, 
      catDigits = 1, 
      contDigits = 2,
      pDigits = 3,
      showAllLevels = TRUE)

# 导出为Word可编辑格式
write.csv(print(table1), "Table1_Baseline.csv")

临床经验：基线表中P值<0.05的变量需要特别关注，这些变量可能在训练集和测试集中分布不均，必要时需要在建模时加入调整。

4. 变量筛选技术详解

4.1 LASSO回归实现

LASSO特别适合处理高维临床数据，能有效解决多重共线性问题：

r复制library(glmnet)

# 准备矩阵格式数据
x <- model.matrix(Outcome ~ ., train_data)[,-1]
y <- ifelse(train_data$Outcome == "Yes", 1, 0)

# 拟合LASSO模型
lasso_model <- glmnet(x, y, 
                     family = "binomial",
                     alpha = 1) # alpha=1表示LASSO

# 交叉验证选择lambda
cv_lasso <- cv.glmnet(x, y, 
                     family = "binomial",
                     nfolds = 10,
                     type.measure = "class")

# 可视化
plot(cv_lasso)

提取最优lambda对应的变量：

r复制# 1个标准误法则选择的lambda
lambda_opt <- cv_lasso$lambda.1se

# 获取非零系数变量
coefs <- coef(cv_lasso, s = lambda_opt)
selected_vars <- rownames(coefs)[which(coefs != 0)][-1] # 排除截距项

4.2 批量单因素分析

对于变量较少的研究，单因素分析更直观：

r复制# 自定义单因素分析函数
uni_logistic <- function(var, data) {
  formula <- as.formula(paste("Outcome ~", var))
  model <- glm(formula, data = data, family = binomial)
  
  # 提取关键指标
  coef <- summary(model)$coefficients
  or <- exp(coef[-1, 1])
  ci <- exp(confint(model)[-1, ])
  p_value <- coef[-1, 4]
  
  data.frame(
    Variable = var,
    OR = or,
    CI_lower = ci[,1],
    CI_upper = ci[,2],
    P_value = p_value
  )
}

# 执行批量分析
vars_to_test <- setdiff(names(train_data), "Outcome")
uni_results <- do.call(rbind, lapply(vars_to_test, uni_logistic, data = train_data))

# 筛选显著变量
sig_vars <- uni_results$Variable[uni_results$P_value < 0.05]

5. 多因素模型构建与验证

5.1 模型拟合

基于筛选的变量构建最终模型：

r复制library(rms)

# 构建模型公式
final_formula <- as.formula(
  paste("Outcome ~", paste(selected_vars, collapse = " + "))
)

# 拟合模型
full_model <- lrm(final_formula, 
                 data = train_data,
                 x = TRUE, 
                 y = TRUE)

# 模型摘要
print(full_model)

5.2 模型性能评估

5.2.1 区分度评估

r复制library(pROC)

# 训练集性能
train_prob <- predict(full_model, train_data, type = "fitted")
train_roc <- roc(train_data$Outcome, train_prob)
plot(train_roc, print.auc = TRUE)

# 测试集验证
test_prob <- predict(full_model, test_data, type = "fitted")
test_roc <- roc(test_data$Outcome, test_prob)
plot(test_roc, print.auc = TRUE)

5.2.2 校准度评估

r复制# 校准曲线
cal_plot <- calibration(Outcome ~ predict(full_model, train_data),
                       data = train_data)
plot(cal_plot)

5.2.3 临床效用评估

r复制library(ggDCA)

# 决策曲线分析
dca_result <- dca(Outcome ~ predict(full_model, train_data),
                  data = train_data)
plot(dca_result)

6. 结果可视化与报告生成

6.1 列线图制作

r复制nomogram <- nomogram(full_model,
                     fun = function(x) 1/(1+exp(-x)), # 逆logit转换
                     funlabel = "Risk Probability")

plot(nomogram)

6.2 动态风险评分工具

将模型转化为Shiny应用，供临床医生交互使用：

r复制library(shiny)

ui <- fluidPage(
  titlePanel("临床风险预测工具"),
  sidebarLayout(
    sidebarPanel(
      # 根据实际变量添加输入控件
      numericInput("age", "年龄", value = 50),
      selectInput("stage", "肿瘤分期", choices = c("I", "II", "III", "IV"))
    ),
    mainPanel(
      plotOutput("nomogram"),
      verbatimTextOutput("prediction")
    )
  )
)

server <- function(input, output) {
  output$prediction <- renderPrint({
    new_data <- data.frame(
      Age = input$age,
      Stage = factor(input$stage, levels = c("I", "II", "III", "IV"))
    )
    risk <- predict(full_model, newdata = new_data, type = "fitted")
    paste0("预测风险: ", round(risk*100, 1), "%")
  })
}

shinyApp(ui, server)