组合学：在不重复元素的情况下随机化，我是否试图做一些不可能的事情？

Question

为标题的措辞道歉，如果答案非常明显，我们深表歉意。我的定量背景并不强，我可能会问一个愚蠢的问题。

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

我想为这些图片标签对中的每一个收集 10 个评分，因此总共有 5520 个评分，我想从 460 个参与者那里收集它们，每个参与者给出 12 个评分。

当我尝试不重复地生成输入文件（选择 12 个图片标签对）时，我的问题出现了。我可以在不重复 pairs 的情况下做到这一点，但我也不希望任何图片在任何给定参与者的输入中出现两次，也不希望任何标签出现两次。

我尝试从一个包含我想要为其收集评分的所有图片标签对的 5520 行的数据框开始。然后我从这个数据框中采样 12 行，直到找到一个不包含任何重复的样本，从数据框中删除这些行并继续。 当我到达一个点，不再可能对 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))

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

你可以让你的问题更容易一点只组合一次，每个只使用 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

---

编辑

OP 担心图片组不断同时出现可能会引入偏差。解决方法是将图片 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

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