R语言生存分析算法的简单组合

复制代码
library(survival)
library(randomForestSRC)

# 生成模拟数据
set.seed(123)
n <- 200
time <- rexp(n, rate = 0.1)
status <- rbinom(n, size = 1, prob = 0.7)
var1 <- rnorm(n)
var2 <- rnorm(n)
var3 <- rnorm(n)
data1 <- data.frame(time = time, status = status, var1 = var1, var2 = var2, var3 = var3)

# 定义模型列表
models <- list(
  cox = function(data) {
    fit <- survival::coxph(Surv(time,status) ~ .,data=data)
    sum<-summary(fit)[["coefficients"]][,5] 
    canshu<-names(sum)
    result<-list(fit=fit,canshu=canshu)
    return(result)
  },
  rsf=function(data){
    fit<-rfsrc(Surv(time,status) ~ .,data=data1)
    canshu<-var.select(object=fit,
                       method="md",
                       conservative="low")$md.obj$topvars.1se
    result<-list(fit=fit,canshu=canshu)
    return(result)
  }
)

# 列举所有模型组合（考虑顺序）
model<-c("cox","rsf")
all_combinations <- list()
library(gtools)
for (n in 1:length(model)) {
  permutations <- permutations(2,n,v=model)
  mat_list <- apply(permutations, 1, function(row) paste(row, collapse = ","))
  mat_vector_list <- lapply(mat_list, function(str) unlist(strsplit(str, ",")))
  all_combinations <- c(all_combinations, mat_vector_list)
}
model_combinations<-all_combinations

# 循环遍历不同模型组合
selected_vars_final <- list()
for (i in 1:length(model_combinations)) {
  comb <- model_combinations[[i]]
  selected_vars <- NULL
  # 循环遍历每个模型类型
  data1<-lung
  for (model_name in comb) {
    i=1
    if (grep(model_name,comb)==1) {
      # 根据前一步的选择变量建立模型并筛选变量
      result <- models[[model_name]](data1)
      cat("第一步:",model_name,"---",result$canshu,"\n")
    } else {
      vc=paste("c(", paste(sprintf('"%s"', selected_vars), collapse = ","), ")", sep = "")
      cat("纳入第二步的因素:",model_name,"---",vc,"\n")
      selected_data <-  data.frame(data1[,eval(parse(text = vc))],
                                   data1[,c("time","status")])
      result <- models[[model_name]](selected_data)
    }
    # 更新选定变量
    selected_vars <- result$canshu
  }
  selected_vars_final[[paste(comb, collapse = "_")]] <- selected_vars
}

print(selected_vars_final)