R语言模拟与X前5变量高相关的指定占比二分类因变量Y

核心逻辑严格遵循优先级要求：优先保证Y与X前5个变量的高相关性，在不破坏相关性的前提下尽可能让Y的1类占比贴近60%、0类占比贴近40%。

核心调整思路 #

• 高相关性保障：重构系数向量，给X前5个变量分配较大的回归系数，剩余25个变量的系数压缩到接近0，让Y的生成逻辑几乎完全由前5个变量驱动，从根源上保证高相关性。
• 类别占比调整：不通过硬改Y值的方式凑占比（该操作会直接破坏相关性），而是通过给线性预测项加截距平移的方式，整体调整正例生成概率，在不改变各变量对Y的影响权重的前提下，让1类占比尽可能接近目标值。
• 偏差容忍：随机生成数据时，最终类别占比可能和目标值有小幅偏差，该偏差属于为保障相关性保留的合理误差，符合优先级要求。

调整后完整代码 #

install.packages("MASS")
library(MASS)

# 基础参数设置
p <- 30
n <- 50
pr <- seq(0.7, 0.4, length.out = p)
pr[1] <- 1
covmat <- toeplitz(pr)
mu <- rep(0,p)

# 生成自变量矩阵X
X_ <- data.frame(mvrnorm(n, mu = mu, Sigma = covmat))
X <- unname(as.matrix(X_))

# 构造系数：优先保障前5个变量和Y的高相关性
vCoef <- numeric(p)
vCoef[1:5] <- rnorm(5, mean = 1.8, sd = 0.4) # 前5个变量分配较大系数
vCoef[6:p] <- rnorm(p-5, mean = 0, sd = 0.03) # 剩余变量系数压缩到接近0，几乎不影响Y

# 调整截距，在不破坏相关性的前提下让1类占比接近60%
lp <- X %*% vCoef
target_pos_rate <- 0.6
# 求解合适的截距项，让整体正例概率均值等于目标占比
adj_intercept <- uniroot(
  function(b) mean(1/(1+exp(-(lp + b)))) - target_pos_rate,
  interval = c(-10, 10)
)$root
vProb <- 1/(1+exp(-(lp + adj_intercept)))

# 生成因变量Y
Y <- rbinom(nrow(X), 1, vProb)
mydata <- data.frame(cbind(X,Y))

# --------------- 可选校验部分 ---------------
# 查看Y和前5个自变量的相关系数，验证高相关性
print("Y与前5个变量的相关系数：")
print(cor(mydata[,1:5], mydata$Y))
# 查看Y的类别占比，验证贴近目标值
print("Y的类别占比（1类/0类）：")
print(table(Y)/length(Y))

注意事项 #

• 不要为了精确凑60%/40%的占比直接修改生成后的Y值，该操作会直接打破Y和前5个变量的相关关系，违反优先级要求。
• 如果需要更高的相关性，可以进一步调大前5个变量的系数、缩小剩余变量的系数标准差；如果需要更贴近目标占比，可以适当增大样本量n，随机波动带来的占比偏差会随样本量提升缩小。

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