如何用R语言gramEvol包实现符号逻辑回归及处理分类变量

现有代码修正与说明 #

你的代码用于通过语法进化（Grammatical Evolution）构建模型，预测手术患者的并发症结局，但存在两处小问题：一是缺少caret包加载（createDataPartition来自该包），二是第一行包导入拼写错误。修正后的完整代码如下：

library(readxl)
library(gramEvol)
library(ggplot2)
library(parallel)
library(caret) # 补充依赖包

data <- read_excel("data.xlsx")

X <- data[,c(3:6,162,163,173)] # 提取目标变量列
y <- data$compl # 二元结局：有并发症/无并发症

set.seed(27)
train_idx <- createDataPartition(y, p = 0.8, list = FALSE)
X_train <- X[train_idx, ]
X_test <- X[-train_idx, ]
y_train <- y[train_idx]
y_test <- y[-train_idx]

grammarDef <- CreateGrammar(list(
  expr  = grule(op(expr, expr), var),
  op    = grule(`+`, `-`, `*`,`/`), # 定义运算符号
  var   = grule(X_train$bmi, X_train$pat_age, n), # 当前仅纳入连续变量
  n     = gvrule(seq(-10,10,by=0.01)) # 可调整的常数项
))

SymRegCostFunc <- function(expr) {
  result <- eval(expr)
  
  if (any(is.nan(result)))
    return(Inf)
  
  return (mean(log(1 + abs(y_train - result))))
}

# 运行语法进化模型
ge <- GrammaticalEvolution(grammarDef, SymRegCostFunc)
ge

纳入分类变量的具体方法 #

分类变量（性别、家族史等）需要先转换为数值型格式，才能融入语法进化的规则中，分两种情况处理：

1. 二元分类变量（如性别、是否有家族史） #

将分类标签转换为0-1编码，例如“男=1，女=0”“有家族史=1，无=0”，之后直接加入语法规则的变量列表。

操作步骤：

• 数据预处理阶段完成编码：

# 示例：对性别和家族史进行0-1编码
X_train$gender_enc <- ifelse(X_train$gender == "男", 1, 0)
X_train$family_hist_enc <- ifelse(X_train$family_hist == "有", 1, 0)

# 测试集需遵循相同编码规则
X_test$gender_enc <- ifelse(X_test$gender == "男", 1, 0)
X_test$family_hist_enc <- ifelse(X_test$family_hist == "有", 1, 0)

• 更新语法规则，加入编码后的变量：

grammarDef <- CreateGrammar(list(
  expr  = grule(op(expr, expr), var),
  op    = grule(`+`, `-`, `*`,`/`),
  var   = grule(X_train$bmi, X_train$pat_age, X_train$gender_enc, X_train$family_hist_enc, n),
  n     = gvrule(seq(-10,10,by=0.01))
))

2. 多分类变量（如手术类型、疾病分期） #

这类变量需要用独热编码转换为多个二元变量，例如手术类型分为A/B/C三类，生成surgery_A/surgery_B/surgery_C三个变量，符合条件则为1，否则为0。

操作步骤：

• 用caret包生成独热编码：

# 示例：对多分类变量surgery_type进行独热编码
dummy_generator <- dummyVars(~ surgery_type, data = X_train)
# 生成训练集哑变量
train_dummies <- predict(dummy_generator, newdata = X_train)
X_train <- cbind(X_train, train_dummies)

# 测试集使用同一生成器保证编码一致
test_dummies <- predict(dummy_generator, newdata = X_test)
X_test <- cbind(X_test, test_dummies)

• 更新语法规则，加入哑变量：

grammarDef <- CreateGrammar(list(
  expr  = grule(op(expr, expr), var),
  op    = grule(`+`, `-`, `*`,`/`),
  var   = grule(X_train$bmi, X_train$pat_age, X_train$surgery_type.A, 
                X_train$surgery_type.B, X_train$surgery_type.C, n),
  n     = gvrule(seq(-10,10,by=0.01))
))

额外优化建议 #

• 为避免除法运算出现0值导致报错，可在成本函数中增加异常捕获：

SymRegCostFunc <- function(expr) {
  result <- tryCatch(eval(expr), error = function(e) Inf)
  
  if (any(is.nan(result)) || any(is.infinite(result)))
    return(Inf)
  
  return (mean(log(1 + abs(y_train - result))))
}

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