随机抽取 table 个单元格 - 行和列的 N 相等

Question

我计划让 12 个人回答 300 个问题。每个科目将回答100个问题，每个问题由4个科目回答。

由于各种原因，分配必须是随机的。这是我处理这个问题的方法，但我愿意接受任何想法。

我创建了一个空白的 300*12 数据框（300 行由问题 ID 命名，12 列用于主题）。对于每个主题列，随机抽取 100 行并在 100 个单元格中输入“1”。因此，我可以确保每个主题随机分配到 100 个问题，但并非所有问题都恰好由 4 个主题回答。

Answer 1

因为这是社区生态中出现的问题（用观察到的边缘生成"null communities"），你可以使用vegan包中的permatswap()函数来完成。

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

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 和 ?make.commsim 来自 vegan 的帮助页面，以了解一些技术问题...

您也可以通过搜索有关 拉丁方 设计的文献找到解决方案。（在 R 中：library("sos"); findFn("latin square")）

Answer 2

@ben-bolker 的回答更优雅，但我想我会 post 我的答案，因为我已经把它编码了。这个想法是模仿如果一个人手动完成任务可能会做什么。我们创建一个从 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

随机抽取 table 个单元格 - 行和列的 N 相等

Randomly sample table cells - equal N across rows and columns

random

r

sampling