这个需求很常见——要让优秀学生倾向于答对所有题，本质是要让学生的能力水平成为影响所有题目正确率的共同驱动因素。能力强的学生，每道题答对的概率都更高；能力弱的学生，答错的概率也会同步上升，这样自然就形成了题目答案之间的相关性。

下面是具体的实现方案，基于你原来的代码改造：

核心思路拆解 #

• 先给每个学生生成一个能力得分：用正态分布模拟，分数越高代表能力越强
• 根据能力得分调整每道题的答对概率：能力越高，对应题目选对正确答案的概率就越高
• 基于调整后的概率，为每个学生生成每道题的答案

完整代码实现 #

# 基础设置
num_students <- 10 # 学生数量
correct_answers <- c(Q1 = "B", Q2 = "A") # 各题正确答案

# 1. 生成学生能力值：用正态分布模拟，均值0，标准差1，分数越高能力越强
# 你可以调整mean和sd来改变整体学生的能力分布，比如mean=0.5让整体能力偏强
student_ability <- rnorm(num_students, mean = 0, sd = 1)

# 2. 定义每道题的基础概率分布，以及能力对正确率的影响权重
base_prob <- list(
  Q1 = c(0.1, 0.6, 0.1, 0.1, 0.1), # 你原来的Q1概率，B是正确选项
  Q2 = c(0.5, 0.1, 0.1, 0.2, 0.1)  # 你原来的Q2概率，A是正确选项
)
ability_weight <- 0.3 # 能力对正确率的影响程度，值越大，题目间相关性越强

# 3. 循环为每个学生生成答案
answers <- data.frame(
  Q1 = character(num_students),
  Q2 = character(num_students),
  stringsAsFactors = FALSE
)

for (i in 1:num_students) {
  # 调整Q1的概率：给正确选项B的概率加上能力带来的加成
  q1_probs <- base_prob$Q1
  correct_pos_q1 <- which(LETTERS[1:5] == correct_answers["Q1"])
  q1_probs[correct_pos_q1] <- q1_probs[correct_pos_q1] + ability_weight * student_ability[i]
  
  # 确保概率合法：不能为负，且总和为1
  q1_probs <- pmax(q1_probs, 0)
  q1_probs <- q1_probs / sum(q1_probs)
  
  # 同理调整Q2的概率
  q2_probs <- base_prob$Q2
  correct_pos_q2 <- which(LETTERS[1:5] == correct_answers["Q2"])
  q2_probs[correct_pos_q2] <- q2_probs[correct_pos_q2] + ability_weight * student_ability[i]
  
  q2_probs <- pmax(q2_probs, 0)
  q2_probs <- q2_probs / sum(q2_probs)
  
  # 生成当前学生的答案
  answers$Q1[i] <- sample(LETTERS[1:5], 1, prob = q1_probs)
  answers$Q2[i] <- sample(LETTERS[1:5], 1, prob = q2_probs)
}

# 把能力值也加上，方便你观察相关性
answers$ability_score <- round(student_ability, 2)
print(answers)

关键细节说明 #

• 能力权重的作用：ability_weight是控制相关性强弱的关键。如果设为0，就回到你原来的独立生成答案的状态；值越大，能力强的学生答对所有题的概率就越高，题目间的相关性也就越明显。
• 概率调整逻辑：我们给正确选项的概率加上能力值×权重，然后重新归一化，这样既保证了概率的合法性，又让能力强的学生更大概率选对。
• 扩展到多题：如果你的测试不止2道题，把上面的逻辑封装成函数会更高效，比如：

# 封装成函数，方便批量处理多道题
generate_single_answer <- function(base_probs, correct_ans, ability, weight) {
  correct_pos <- which(LETTERS[1:5] == correct_ans)
  adjusted_probs <- base_probs
  adjusted_probs[correct_pos] <- adjusted_probs[correct_pos] + weight * ability
  adjusted_probs <- pmax(adjusted_probs, 0)
  adjusted_probs <- adjusted_probs / sum(adjusted_probs)
  return(sample(LETTERS[1:5], 1, prob = adjusted_probs))
}

# 用函数快速生成多题答案
answers <- data.frame(
  Q1 = sapply(student_ability, function(x) generate_single_answer(base_prob$Q1, "B", x, ability_weight)),
  Q2 = sapply(student_ability, function(x) generate_single_answer(base_prob$Q2, "A", x, ability_weight)),
  ability_score = round(student_ability, 2),
  stringsAsFactors = FALSE
)

这样你只需要添加新题的基础概率和正确答案，就能轻松扩展测试题量啦。

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