R语言编写带数量约束的岩石教学样本随机分配脚本

需求说明 #

• 岩相学课程考核需制作24个样本盒，每个样本盒放置2种不同岩石供学生识别
• 初始可用岩石类型共5种：granite（花岗岩）、pumice（浮石）、gneiss（片麻岩）、marl（泥灰岩）、chalk（白垩）
• 库存约束：marl和chalk两类岩石各自仅备有3份，即最终分配结果中两类岩石的总出现次数均不得超过3次，其余3类岩石无库存限制

原无约束随机抽样代码未对两类低库存岩石的使用次数做限制，可能生成超量分配的不可行结果。

修改方案 #

核心逻辑：每次抽样前动态更新可选岩石池，已经用满3份的受限岩石直接移出候选池，再从剩余可选岩石中抽取2种不同岩石，从抽样环节就避免超量。由于存在3种无库存限制的岩石，即使两类受限岩石全部耗尽，剩余岩石也能满足每次抽2种不同样本的要求，不会出现候选池不足的报错。

修改后的可运行代码如下：

# 初始化岩石列表
rocks <- c("granite","pumice","gneiss","marl","chalk")
# 初始化两类受限岩石的使用计数
marl_used <- 0
chalk_used <- 0
# 预分配24行2列的结果矩阵，比循环里逐行rbind效率更高
box <- matrix(nrow = 24, ncol = 2, dimnames = list(NULL, c("rock1", "rock2")))

for (i in 1:24) {
  # 生成本次抽样的可选岩石池
  candidate <- rocks
  # 泥灰岩用满3份就移出候选池
  if (marl_used >= 3) candidate <- candidate[candidate != "marl"]
  # 白垩用满3份就移出候选池
  if (chalk_used >= 3) candidate <- candidate[candidate != "chalk"]
  
  # 从候选池抽取2种不同岩石
  current_samp <- sample(candidate, 2)
  # 更新使用计数
  if ("marl" %in% current_samp) marl_used <- marl_used + 1
  if ("chalk" %in% current_samp) chalk_used <- chalk_used + 1
  # 写入结果矩阵
  box[i, ] <- current_samp
}

结果校验 #

运行完代码后可以执行以下命令确认符合库存要求：

# 统计泥灰岩总使用量，返回值≤3即符合要求
sum(box == "marl")
# 统计白垩总使用量，返回值≤3即符合要求
sum(box == "chalk")

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