Question

我正在为一所大学班级（约180名学生）创建一个小组作业，我正在指导。重要的是，这些群体在三个变量（学习领域（FOS），性别，分工：即新生/年长学生）中尽可能地保持异质性。

FOS有5个级别，性别有2个，分区有2个。鉴于该项目，我想创建大约8-9个组。换句话说，我喜欢大约6人的团体，他们在不同的学习领域，男性/女性以及新老学生之间保持着“良好”的平衡。然后，我只需使用自动分配发布名称。

导师之前用手完成了所有操作，但是我尝试过玩R来看看是否有更系统的方法来做这个，但只是想出了重复（和笨重）的排序。我预计5个FOS级别的大小会有所不同，所以我认为它不是一个完美的解决方案。对人们聪明的解决方案感兴趣。这是一个可重复的样本：

dat <- data.frame(
  student = 1:180,
  gender = factor(sample(LETTERS[1:2], 180, replace = T, prob = c(.52,.48)),
                  labels=c("female","male")),
  division = factor(sample(LETTERS[1:2], 180, replace = T, prob = c(.6,.4)),
                  labels=c("lower","upper")),
  field = factor(sample(LETTERS[1:5], 180, replace = T, 
                   prob = c(.26,.21,.35,.07,.11)),
                   labels = c("humanities","natural science",
                              "social science","engineer","other")))

这就是我正在玩的东西，但它确实增加了作业的随机性，而不是可以看到的平衡：

library(dplyr)
dat$rand <- sample(1:180,180)

dat1 <- arrange(dat, field, division, gender, rand)
dat1$grp <- 1:(nrow(dat1)/6) #issue if not divisible

这不会产生足够的平衡：

with(dat1, table(gender, grp)) #as a check
with(dat1, table(field, grp))
with(dat1, table(division, grp))

Answer 1

我知道这是一个老问题，但是今天我也遇到了类似的问题，这就是我想出的解决方案。基本上，您是随机分配组，然后对类别变量使用卡方检验，对于连续变量使用ANOVA检验每个变量的组差异。您为不想降低的p值设置了阈值。该代码将重新排列组，直到所有p值都高于该阈值。如果经过10,000次迭代而没有达到分组解决方案，它将停止并建议您降低阈值。

set.seed(905)
#let's say you have a continuous variable you would also like to keep steady across groups
dat$age <- sample(18:35, nrow(dat), replace = TRUE)

dat$group <- rep_len(1:20, length.out = nrow(dat)) #if you wanted to make 20 groups
dat$group <- as.factor(dat$group)
a <- 0.1; b <- 0.1; c <- 0.1; d <- 0.1
thresh <- 0.85 #Minimum threshold for p value
z <- 1
while (a < thresh | b < thresh |c < thresh |d < thresh) {
  dat <- transform(dat, group = sample(group)) #shuffles the groups
  x <- summary(aov(age ~ group, dat)) #ANOVA for continuous variables
  a <- x[[1]]['group','Pr(>F)']
  x <- summary(table(dat$group, dat$gender)) #Chi Sq for categorical variables
  b <- x[['p.value']]
  x <- summary(table(dat$group, dat$division))
  c <- x[['p.value']]
  x <- summary(table(dat$group, dat$field))
  d <- x[['p.value']]
  z <- z + 1
  if (z > 10000) {
    print('10,000 tries, no solution, reduce threshold')
    break
  }
}

Answer 2

每个变量组合有足够的数据点，您应该可以这样做：

dat <- groupdata2::fold(dat, k = 8, 
                        cat_col = c("gender", "division", "field")) 

with(dat, table(gender, .folds))
##         .folds
## gender    1  2  3  4  5  6  7  8
## female   11 12 11 12 12 11 12 12
##   male   10 11 11 11 11 11 11 11

with(dat, table(field, .folds))
##                 .folds
##   field           1 2 3 4 5 6 7 8
##   humanities      5 8 9 7 9 6 6 5
##   natural science 2 3 4 6 3 9 2 4
##   social science  9 7 6 8 5 6 9 6
##   engineer        3 3 2 1 3 0 2 4
##   other           2 2 1 1 3 1 4 4

with(dat, table(division, .folds))
##         .folds
## division  1  2  3  4  5  6  7  8
##    lower 11 15 13 14 10 13 11 15
##    upper 10  8  9  9 13  9 12  8

基于三个分类变量创建平衡组

2 个答案: