将行分配/拆分为相同大小的组，每组最多一个阈值

Question

我已经在这方面工作了一段时间，我无法找到任何能够实现我需要的解决方案......

简单来说，我有一个带有两列的DF，比方说，'n'不同的行（例如学生的名字），以及'm'不同的主管名称。 'n'可以大于或小于'm'。

问题：

1. 随机将'n'学生分配到主管团体'm'，以便每个主管在他的小组中接收相同数量的学生（或者如果'n'和'm'不是倍数则尽可能接近）。
2. 有些学生已经被分配到特定的主管。也就是说，一些组在开头是空的，有些组已经分配了一些行。
3. 每组的行数限制对于每个组都是相同的，这就是round(n/m)。
4. 已分配到一个组中的行'n'不能切换到新组。

到目前为止，我一直在尝试用dplyr对问题进行排序，使用不同的表格，为每个观察分配索引......但我觉得我的代码对于这类问题来说太复杂了，所以我想知道是否有人知道更简单的解决方案。

为了视觉目的，我将保留我的数据框样本。当然，我正在使用不同类型的信息来处理更大的数据集。但问题完全一样：

我有：

Names_stud (n)     Supervisors (m)
Ralph              SKINNER
Michael            NA
Mitch              NA
Julen              NA
Richard            CARAPAPEL        
John               NA
Ramon              SKINNER
Laura              McGONAGALL
Paul               NA
Ivy                NA
Lucas              NA
Mathiew            NA

我想拥有什么：

Names_students     Supervisor
Ralph              SKINNER
Michael            CARAPAPEL
Mitch              SKINNER
Julen              McGONAGALL
Richard            CARAPAPEL        
John               CARAPAPEL
Ramon              SKINNER
Laura              McGONAGALL
Paul               McGONAGALL
Ivy                SKINNER
Lucas              McGONAGALL
Mathiew            CARAPAPEL

这样：

table(DF$Supervisors)

McGONAGALL     SKINNER     CARAPAPEL
         4           4             4

在'n'不是'm'的倍数的情况下，完全可以得到最接近的结果（例如4,3,3或4,4,3 ......）。

到目前为止，我已经用dplyr完成了很多编码，为以前分配的学生分配索引......但是我总是卡在某处，我觉得我处理它的方式是效率低下的。

我想知道是否有人知道解决这个问题的具体方案。我还检查了'拆分'包。在那里找不到任何有用的东西。

非常感谢你提前。如果您需要进一步澄清，请询问。

PD：我找不到任何与此特定问题相关的问题。如果有一个有正确答案的请告诉我。

再次，先谢谢。

Answer 1

我认为这可能适用于您想要做的事情。 myFun只是列出了随机的“学生”，并且样本生成了一个不均衡的“顾问”列表，其中NA值约为70％。然后for循环使用在表调用中具有最低值的顾问程序填充NA。

如果任何人都可以在没有for循环的情况下以更合适的方式执行此操作，我真的很有兴趣看到它。

myFun <- function(n = 5000) {
  a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
  paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
}

students <- myFun(50)
advisors <- sample(c("TA1", "TA2", "TA3", NA), size = 50, replace = TRUE, prob = c(0.1, 0.2, 0.1, 0.7))
datFrame <- data.frame(students, advisors)

for(i in 1:length(datFrame$advisors)){
  ifelse(is.na(datFrame$advisors[i]),
         datFrame$advisors[i] <- names(table(datFrame$advisors))[which.min(table(datFrame$advisors))],
         datFrame$advisors[i] <- datFrame$advisors[i])
}

table(datFrame$advisors)

Answer 2

这是另一种方法，我认为它比MR更有效，希望同样容易理解。

这是一个赋值问题（二分匹配），但约束非常简单，您可以在不使用较重算法或专用整数编程工具的情况下逃脱。

这里的策略是为那些还没有主管的学生生成作业的“右侧”，然后将这些新作业与现有作业绑定。

为此，我们创建一个足够长的监督者循环向量，然后从已经有学生的向量顶部开始放弃监督者，以确保最终的群体是平衡的。

set.seed(1)

n <- 10
m <- 3

# Initialise our students and supervisors
students <- sample(letters, n, replace = FALSE)
supers <- sample(LETTERS, m, replace = FALSE)

# Create your dataframe and randomly assign a few supers
df <- data.frame(student = students,
                 super = NA, stringsAsFactors = FALSE)
df[sample(1:n, 2), "super"] <- sample(supers, 2)

# Each supervisor must be assigned to [floor(n / m), ceiling(n / m)] students
# We can ensure this by cycling through supervisors... 
to_assign <- rep(supers, ceiling(n / m))

# ... but only if we skip those that have already been assigned to a student
for (super in df[!is.na(df$super), "super"]) {
  to_assign <- to_assign[-match(super, to_assign)]
}

new_assignments <- df[is.na(df$super), ]
new_assignments$super <- to_assign[1:nrow(new_assignments)]

result <- rbind(df[!is.na(df$super), ], new_assignments)

我不认为为了避免循环应该避免循环，在这种情况下我认为它很好并且生成简单的代码，但是你可以通过更聪明地使用数据结构来做得更好。