Question

我有以下数据框

 design <- read.table(text =
"block position
 1     1
 1     2
 1     3
 1     4
 2     1
 2     2
 2     3
 2     4", header = TRUE)

我想在一个区块内随机分配四种治疗方法。我可以使用以下代码执行此操作：

treatment <- letters[1:4]
set.seed(2)
design$treatment <- as.vector(replicate(2,sample(treatment, length(treatment))))

产生以下数据框

> design
 block position treatment
 1        1         a
 1        2         c
 1        3         b
 1        4         d
 2        1         d
 2        2         c
 2        3         a
 2        4         b

问题：在上面的例子中，治疗c在位置2处是两次。一次治疗不应该在同一位置两次。我怎样才能做到这一点？

更一般：是否有一个简单的约束采样解决方案？

Answer 1

以下方法应确保（1）治疗的随机性，以及（2）不同区块在同一位置的不同治疗方法。

我们使用%timeit计算letters[1:4]的所有排列。我们将这组排列存储在矩阵gtools::permutations中。
```
perm
```
我们创建一个空的# Calculate all permutations of letters[1:4] library(gtools); treatment <- letters[1:4]; perm <- permutations(length(treatment), length(treatment), treatment);向量，将逐块连续填充。
```
treatment
```
我们现在从design$treatment <- "";为第一个perm随机抽取一个排列。一旦我们绘制了排列，我们就会删除block（即我们的排列集）中的所有排列，这些排列在相同位置具有任何相同的条目。然后，我们从第二个perm的简化排列集中随机抽取排列。等等。
```
block
```

删除set.seed(2017); for (i in 1:length(unique(design$block))) { smpl <- perm[sample(nrow(perm), 1), ]; design$treatment[seq(1 + 4 * (i - 1), 4 * i)] <- smpl; # Remove all permutations with duplicated letters j <- 1; while (j <= nrow(perm)) { if (any(perm[j, ] == smpl)) perm <- perm[-j, ] else j <- j + 1; } } design; # block position treatment #1 1 1 d #2 1 2 c #3 1 3 a #4 1 4 b #5 2 1 b #6 2 2 a #7 2 3 d #8 2 4 c以使用随机种子。

Answer 2

此解决方案适用于大量治疗，并基于answer of Maurits Evers。只计算1000个排列而不是所有可能的排列。

n_treat <- 20

# make large design file
design <- data.frame(block = rep(1:4, each = n_treat), position = rep(1:n_treat, 4))

# Calculate some (not all) random permutations
treatment <- 1:n_treat
perm <- t(replicate(1000,sample(treatment, length(treatment), replace = F)))

# Create empty treatment vector
design$treatment <- ""

# loop through all blocks,
# randomly draw a permutation from perm,
# remove permutations with identiacal entries at the same position.
set.seed(2017);
for (i in 1:length(unique(design$block))) {
  smpl <- perm[sample(nrow(perm), 1), ];
  design$treatment[seq(1 + n_treat * (i - 1), n_treat * i)] <- smpl;
  # Remove all permutations with duplicated letters
  j <- 1;
  while (j <= nrow(perm)) {
    if (any(perm[j, ] == smpl)) perm <- perm[-j, ] else j <- j + 1;
  }
}

带约束的约束/随机化样本

2 个答案: