如何使用 R 在没有边界重复的情况下生成七块内的随机数序列?

How to produce a a randomized number sequence within seven block without boundary repeat using R?

有 9 个治疗,我们想要 7 个区块。在每个区块中,应重复处理一次。

9个治疗标记如下:

-Treatment 1 (1-7)
-Treatment 2 (8-14)
-Treatment 3 (15-21)
-Treatment 4 (22-28)
-Treatment 5 (29-35)
-Treatment 6 (36-42)
-Treatment 7 (43-49)
-Treatment 8 (50-56)
-Treatment 9 (57-63)

每个数字代表一个底池。我们希望这些花盆随机分为 7 个块(列),但我们不希望两个相同处理的花盆彼此相邻 - 以灰色突出显示:

我如何在 R 中解决这个问题?

如果我解释正确,这应该有效。

我们将进行两步抽样:

  1. 首先,对处理组本身进行抽样,从而更容易确定块中的特定行是否与前一个块的同一行属于同一处理组。
  2. 其次,从每个已证明安全的组中抽取一个样本。

我将在此处使用随机种子以实现可重复性,请勿在生产中使用 set.seed(.)

set.seed(42)
nBlocks <- 7
treatments <- list(1:7, 8:14, 15:21, 22:28, 29:35, 36:42, 43:49, 50:56, 57:63)
blocks <- Reduce(function(prev, ign) {
  while (TRUE) {
    this <- sample(length(treatments))
    if (!any(this == prev)) break
  }
  this
}, seq.int(nBlocks)[-1], init = sample(length(treatments)), accumulate = TRUE)
blocks <- do.call(cbind, blocks)
blocks
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7]
#  [1,]    1    3    4    2    8    2    1
#  [2,]    5    1    2    4    5    7    9
#  [3,]    9    8    9    3    1    3    5
#  [4,]    7    9    3    6    7    9    3
#  [5,]    2    4    8    5    4    1    4
#  [6,]    4    7    1    9    6    4    2
#  [7,]    8    6    5    7    2    6    8
#  [8,]    3    5    6    8    9    5    6
#  [9,]    6    2    7    1    3    8    7

此处每一列都是一个“块”,每个数字代表分配给每一行的处理组。您可以看到在后续列中没有任何行包含相同的组。

例如,第一列(“块 1”)将在第一行包含来自治疗 1 组的内容,在第二行包含来自治疗 5 组的内容,等等。此外,检查将显示所有治疗都包含在每个块列,实验设计的推断要求。

(仅供参考,根据随机条件,理论上这可能需要一段时间。因为它按列重复,所以应该相对有效。我在这里没有针对执行时间过长的保护措施,但我认为这不是必需的:这里的条件不太可能导致需要多次重复的“失败”。)

下一步是将这些组编号中的每一个转换为来自相应治疗组的编号。

apply(blocks, 1:2, function(ind) sample(treatments[[ind]], 1))
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7]
#  [1,]    6   17   22   11   54   14    3
#  [2,]   30    3   13   22   33   48   58
#  [3,]   63   55   61   15    4   21   33
#  [4,]   49   60   21   36   43   58   21
#  [5,]   12   25   55   32   27    7   25
#  [6,]   24   46    4   58   38   28   11
#  [7,]   53   38   35   49   11   36   56
#  [8,]   16   29   36   56   63   29   40
#  [9,]   36    8   47    3   19   50   43

为了验证,在第一个矩阵中,我们的前三行(块 1)是 1、5 和 9,它们应该分别转换为 1-7、29-35 和 57-63。 “6”在1-7之间,“30”在29-35之间,“63”在59-63之间。检查将显示余数是正确的。

由于先确定治疗组的步骤,verify/guarantee更简单,您不会在两个相邻块之间连续重复治疗组。


编辑

规则:

  1. 相同的治疗组可能不在相邻列的同一行;和
  2. 相同的治疗(不是组)可能不在相邻列的任何行中。

我们可以使用与以前相同的方法。请注意,随着任何组变小,迭代时间可能会增加,但我不认为它可能会进入无限循环。 (不过,如果你不小心有一组长度为1的,那……这就没完没了了。)

nBlocks <- 7
treatments <- list(1:7, 8:14, 15:21, 22:28, 29:35, 36:42, 43:49, 50:56, 57:63)

# helper function for randomized selection of treatments given groups
func <- function(grp) cbind(grp, sapply(treatments[grp], sample, size = 1))
set.seed(42)
func(c(1,3,5))
#      grp   
# [1,]   1  1
# [2,]   3 19
# [3,]   5 29

然后是相同的 Reduce 心态:

set.seed(42)
blocks <- Reduce(function(prev, ign) {
  while (TRUE) {
    this1 <- sample(length(treatments))
    if (!any(this1 == prev[,1])) break
  }
  while (TRUE) {
    this2 <- func(this1)
    if (!any(this2[,2] %in% prev[,2])) break
  }
  this2
}, seq.int(nBlocks-1), init = func(sample(length(treatments))), accumulate = TRUE)
blocks <- do.call(cbind, blocks)
groups <- blocks[, seq(1, by = 2, length.out = nBlocks)]
treats <- blocks[, seq(2, by = 2, length.out = nBlocks)]

据此,我们有两个产品(尽管您可能只关心第二个):

  1. 处理组,很好地验证了上面的规则 1:任何组都不能在相邻列的同一行中:

    groups
    #       grp grp grp grp grp grp grp
    #  [1,]   1   3   1   7   8   5   1
    #  [2,]   5   1   2   8   2   7   3
    #  [3,]   9   8   5   2   1   4   6
    #  [4,]   7   9   6   3   4   8   5
    #  [5,]   2   4   7   9   3   9   4
    #  [6,]   4   7   4   5   7   1   2
    #  [7,]   8   6   9   1   9   6   7
    #  [8,]   3   5   8   6   5   2   9
    #  [9,]   6   2   3   4   6   3   8
    
  2. 治疗本身,对于上面的规则 2,相邻列中可能没有治疗:

    treats
    #                           
    #  [1,]  7 19  2 47 51 33  3
    #  [2,] 35  4 12 50  8 44 15
    #  [3,] 60 51 35 10  1 22 41
    #  [4,] 43 58 41 21 26 55 31
    #  [5,] 12 24 43 57 17 57 26
    #  [6,] 27 49 26 34 48  6 11
    #  [7,] 53 36 62  6 62 36 47
    #  [8,] 16 33 54 42 32 10 62
    #  [9,] 37  9 15 27 37 18 56
    

编辑 2:

另一个规则:

  1. 每个治疗组必须在每一行和每一列中只看到一次(需要方形实验设计)。

我认为这有效地生成了类似数独的治疗矩阵 groups,一旦满足,回填规则 #2(不重复 treatments 在相邻的列中)。 https://gamedev.stackexchange.com/a/138228:

建议的一种方法(虽然很仓促)
set.seed(42)
vec <- sample(9)
ind <- sapply(cumsum(c(0, 3, 3, 1, 3, 3, 1, 3, 3)), rot, x = vec)
apply(ind, 1, function(z) all(1:9 %in% z)) # all rows have all 1-9, no repeats
# [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
apply(ind, 1, function(z) all(1:9 %in% z)) # ... columns ...
# [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
ind
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
#  [1,]    1    7    8    3    5    2    4    6    9
#  [2,]    5    2    3    6    9    4    8    1    7
#  [3,]    9    4    6    1    7    8    3    5    2
#  [4,]    7    8    1    5    2    3    6    9    4
#  [5,]    2    3    5    9    4    6    1    7    8
#  [6,]    4    6    9    7    8    1    5    2    3
#  [7,]    8    1    7    2    3    5    9    4    6
#  [8,]    3    5    2    4    6    9    7    8    1
#  [9,]    6    9    4    8    1    7    2    3    5

鉴于对组的限制,这使得随机组排列的样式相当固定。由于这是实验设计,如果您要使用此方法(并且块之间的接近度是一个问题),那么您应该随机化 ind 矩阵的 and/or 行 before 对治疗本身进行抽样。 (你可以做列和行,只是分段做,它应该保留约束。)

ind <- ind[sample(9),][,sample(9)]
ind
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
#  [1,]    2    3    8    1    4    7    9    6    5
#  [2,]    7    8    4    6    2    9    5    3    1
#  [3,]    1    7    9    4    5    6    3    2    8
#  [4,]    8    1    6    9    3    4    2    5    7
#  [5,]    5    2    7    8    9    1    6    4    3
#  [6,]    3    5    1    7    6    8    4    9    2
#  [7,]    4    6    3    5    8    2    7    1    9
#  [8,]    6    9    5    2    1    3    8    7    4
#  [9,]    9    4    2    3    7    5    1    8    6

从这里,我们可以制定规则 2:

treatments <- list(1:7, 8:14, 15:21, 22:28, 29:35, 36:42, 43:49, 50:56, 57:63)

mtx <- do.call(rbind, Reduce(function(prev, ind) {
  while (TRUE) {
    this <- sapply(treatments[ind], sample, size = 1)
    if (!any(prev %in% this)) break
  }
  this
}, asplit(ind, 2)[-1],
init = sapply(treatments[ind[,1]], sample, size = 1),
accumulate = TRUE))
mtx
#       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
#  [1,]   11   44    4   52   30   15   23   41   59
#  [2,]   16   56   49    3   12   33   39   57   27
#  [3,]   52   24   60   40   46    2   20   29   13
#  [4,]    1   37   23   63   56   48   32   12   17
#  [5,]   24   10   30   16   58   39   50    2   47
#  [6,]   49   57   41   25    6   52   11   17   34
#  [7,]   59   31   19   14   38   23   47   51    7
#  [8,]   41   17   11   33   24   61    5   43   54
#  [9,]   29    4   51   45   20    8   58   28   40