组合学：随机化不重复的元素，我是不是想做不可能的事情？

Question

为题目的措辞道歉，如果答案非常明显，也请原谅。我的量化背景不强，我可能问了一个愚蠢的问题。

我有一组24个项目，我们可以把它们想象成图片，以及24个图片的标签。这意味着我有552个可能的图片标签对。

我想为每个图片标签对收集10个评分，所以总共有5520个评分，我想从460个参与者那里收集，每个人给12个评分。

当我试图不重复地生成输入文件（选择12个图片标签对）时，我的问题就出现了。我可以不重复地生成 成对但我也不希望任何图片在任何参与者的输入中出现两次，也不希望任何标签出现两次。

我试着从一个有5520行的数据框开始，其中包含了我想收集的所有图片-标签对的评分。然后我从这个数据框中抽取12行样本，直到找到一个不包含任何重复的样本，从数据框中删除这些行，然后继续。这样做的结果是卡在了一个无限的while循环中，因为我达到了一个点，在这个点上，我不可能再从剩下的行中取样一个没有重复的df。

这是因为我的方法是错误的，还是我想做一些不可能的事情？

pairs <- as.data.frame(permutations(n = 24, r = 2, v = seq(1:24), repeats.allowed=F))
nrow(pairs)

for (i in seq(1, to =552, by =12)) {

#get sample
s <- sample(nrow(shuffled_pairs),12)
d <- shuffled_pairs[s,]

#check for repetitions of either V1 (pic) or V2 (label)
while (length(unique(d$V1))<12 | length(unique(d$V1))<12) {
    s <- sample(nrow(shuffled_pairs),12)
    d <- shuffled_pairs[s,]    
}

shuffled_pairs <- shuffled_pairs[-s,]

}

Answer 1

答案是这是不可能的，46个评分者：你需要48个评分者，每个人做12个评分，以覆盖10 * 24 * 24，或5760，你需要的样本。然而，有了这个警告，它是可能得到所有的样本，你想在所需的限制。代码本身很短。

mod24 <- function(x) (x + 0:11 - 1) %% 24 + 1

df <- data.frame(picture = rep(c(rep(1:12, 24), rep(13:24, 24)), 10),
                 label = rep(do.call("c", lapply(1:24, mod24)), 20),
                 rater   = rep(c(rep(1:48, each = 12)), 10) + rep(0:9 * 48, each = 576))

然而，这需要相当多的解释。

你可以通过注意到，无论你做什么，你都可以把你的480人分成10组，每组48人，每组都做同样的事情，即他们之间对每个图片标签组合的评分正好一次，每个人正好使用12个评分，从而使你的问题变得简单一些。所以你可以关注一下48人中的一组如何执行这个任务，将576种可能性全部准确地覆盖一次。

另外需要注意的是，由于每个人都要选出12幅画，你可以进一步简化，把48人小组分成两组，每组24人，他们得到前12幅或后12幅画。这样一来，你就可以保证每个评分者不会有任何重复的画作。

现在你需要做的就是保证每幅画的标签都准确地给一次。你可以做到这一点，给第一个参与者的绘画标签1:12，然后第二个参与者的绘画标签2:13等，直到你得到13:24，之后的标签成为 c(14:24, 1)那么 c(15:24, 1:2) 等。这确保了在1:12的画组中，每幅画都得到一次且仅有一次的标签分配。现在对13:24的画作做同样的处理。你将有48人，每个人有12个标签，覆盖所有可能的组合一次。

对每组48人做同样的操作，你将对每幅独特的图片标签对有10个评分，每个评分者将给出12个评分，没有评分者会对同一幅画或标签评分两次。

回到我们的代码，我们可以看到df包含5760个样本。

nrow(df)
#> [1] 5760

它有576个独特的图片和标签组合，每个重复10次。

table(df$picture, df$label)
#>     
#>       1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
#>   1  10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   2  10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   3  10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   4  10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   5  10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   6  10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   7  10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   8  10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   9  10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   11 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   12 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   13 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   14 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   15 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   16 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   17 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   18 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   19 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   20 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   21 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   22 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   23 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
#>   24 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10

而480个评分者中的每个人都有12对样本进行评分

table(table(df$rater))

#>  12 
#> 480 

都是独一无二的。

table(sapply(split(df, df$rater), function(x) nrow(unique(x))))

#>  12 
#> 480

---

编辑：

上位者担心图片组的不断共现可能会带来偏差。绕过这个问题的方法是将图片1:12组的第一个人和13:24组的第一个人配对，让他们随机交换部分分配。他们的图片不能成为重复的，因为他们的图片没有重叠，他们的标签也不能成为重复的，因为他们总是交易相同的标签。

swaps <- do.call(c, lapply(1:10, function(x) c(rbinom(24 * 12, 1, 0.5), rep(0, 24 * 12))))
swap_out <- df[swaps == 1, ]
df[swaps == 1, ] <- df[which(swaps == 1) + 24 * 12, ]
df[which(swaps == 1) + 24 * 12, ] <- swap_out

这个新的数据框架仍然符合所有的规范。