Question

我计划有12个人回答300个问题。每个主题将回答100个问题，每个问题将由4个主题回答。

由于各种原因，分配必须是随机的。这是我的处理方法，但可以公开提出任何想法。

我创建了一个空白的300 * 12数据框（由问题ID命名的300行和主题的12列）。对于每个主题列，随机采样100行，并在100个单元格中添加“ 1”。结果，我可以确保将每个主题随机分配给100个问题，但并不是所有问题都能得到4个主题的完全回答。

Answer 1

由于这是社区生态中的一个问题（生成具有观察到的边际的“空社区”），因此可以使用permatswap()包中的vegan函数来实现。

生成具有所需边际的二进制矩阵（非随机）矩阵：

basemat <- matrix(0,nrow=300,ncol=12)
nq <- 100  ## number of questions
qs <- ncol(basemat)*nq/nrow(basemat) ## q per subject
for (i in 1:ncol(basemat)) {
    basemat[1:100+(nq*((i-1) %/% qs)),i]  <- 1
}
## check margins
all(rowSums(basemat)==qs)
all(colSums(basemat)==nq)

现在交换：

pp <- permatswap(basemat,times=1)
pp$perm[[1]]  ## extract matrix

这将生成一个具有指定边距的随机二进制矩阵。这是一个相当困难的计算问题：根据随机化属性对您的重要性，您至少应在结果上使用image()以便从视觉上检查它看起来是否混乱，并强烈考虑深入研究{{来自?permatswap的1}}和?make.commsim帮助页面，以了解一些技术问题...

您还可以通过搜索有关拉丁方形设计的文献来找到解决方案。（在R中：vegan）

Answer 2

@ ben-bolker的答案更为优雅，但我认为我应该发布答案，因为我已经对其进行了编码。想法是模仿如果手动进行分配会做什么。我们创建一个从1到300的数字池，其中每个数字重复4次。然后，主题1绘制100个数字而不替换，如果绘制了主题1已经绘制的数字，则重新绘制。然后，主题2会执行相同的操作，然后一直重复到主题11。

N <- 12
K <- 100
set.seed(123)

pool <- rep(1:300, each = 4)
assignments <- vector("list", N)
for (i in 1:(N - 1)) {
  for (j in 1:K) {
    repeat {
      draw <- sample(pool, 1)
      if (!(draw %in% assignments[[i]]))
        break
    }
    assignments[[i]] <- c(assignments[[i]], draw)
    pool <- pool[-which(pool == draw)[1]]
  }
}
assignments[[N]] <- pool

主题12以剩下的100个数字结束。这100个数字中可能有重复项。对于每个重复项，主题12都将首先转到主题1。如果主题1尚未具有该编号，主题12会将数字与主题1交换为主题12没有的随机抽取编号。如果主题1已经有编号，则主题12改为主题2（如有必要，主题3，主题4等）

dupes <- assignments[[N]][duplicated(assignments[[N]])]
for (k in 1:length(dupes)) {
  fixed <- FALSE
  xx <- dupes[k]
  counter <- 1
  while (!fixed) {
    if (!(xx %in% assignments[[counter]])) {
      swap <- setdiff(assignments[[counter]], assignments[[N]])[1]
      assignments[[N]][which(assignments[[N]] == xx)[1]] <- swap
      assignments[[counter]][which(assignments[[counter]] == swap)[1]] <- xx
      cat(sprintf("Swapped %d for %d with Subject %d\n", xx, swap, counter))
      fixed <- TRUE
    } else {
      counter <- counter + 1
    }
  }
}

我们可以验证我们是否获得了正确的边际总和：

mat <- matrix(0, nc = 300, nr = 12)
for (i in 1:N) {
  for (j in 1:K) {
    mat[i, assignments[[i]][j]] <- 1
  }
}
unique(rowSums(mat))
# [1] 100
unique(colSums(mat))
# [1] 4

随机采样表单元格-行和列之间等于N

2 个答案: