在 R 中，我如何在本地打乱向量的元素答案

【问题标题】：In R, how do I locally shuffle a vector's elements在 R 中，我如何在本地打乱向量的元素
【发布时间】：2013-07-14 15:09:04
【问题描述】：

我在 R 中有以下向量。将它们视为数字向量。

x = c(1,2,3,4,...100)

我想根据一些输入数字“局部性因子”“局部地”随机化这个向量。例如，如果局部性因子为 3，则取前 3 个元素并随机化，然后是接下来的 3 个元素，依此类推。有没有一种有效的方法来做到这一点？我知道如果我使用样本，它会弄乱整个数组。提前致谢

【问题讨论】：

标签： r sample

【解决方案1】：

Arun 不喜欢我的其他答案效率低下，所以这里有一些非常适合他的东西；)

它只需要调用runif() 和order() 各一次，并且根本不使用sample()。

x <- 1:100
k <- 3
n <- length(x)

x[order(rep(seq_len(ceiling(n/k)), each=k, length.out=n) + runif(n))]
#  [1]   3   1   2   6   5   4   8   9   7  11  12  10  13  14  15  18  16  17
# [19]  20  19  21  23  22  24  27  25  26  29  28  30  33  31  32  36  34  35
# [37]  37  38  39  40  41  42  43  44  45  47  48  46  51  49  50  52  54  53
# [55]  55  57  56  58  60  59  62  63  61  66  64  65  68  67  69  71  70  72
# [73]  75  74  73  76  77  78  81  80  79  84  82  83  86  85  87  89  88  90
# [91]  93  92  91  94  96  95  97  98  99 100

【讨论】：

【解决方案2】：

一般解决方案：

编辑：正如@MatthewLundberg cmets，我指出的“x 中的重复数字”问题可以通过处理seq_along(x) 轻松解决，这意味着结果值将是索引。所以，应该是这样的：

k <- 3
x <- c(2,2,1, 1,3,4, 4,6,5, 3)
x.s <- seq_along(x)
y <- sample(x.s)
x[unlist(split(y, (match(y, x.s)-1) %/% k), use.names = FALSE)]
# [1] 2 2 1 3 4 1 4 5 6 3

旧答案：

这里的瓶颈是函数sample 的调用量。只要你的号码不重复，我认为你可以通过这种方式拨打sample来做到这一点：

k <- 3
x <- 1:20
y <- sample(x)
unlist(split(y, (match(y,x)-1) %/% k), use.names = FALSE)
# [1]  1  3  2  5  6  4  8  9  7 12 10 11 13 14 15 17 16 18 19 20

将所有内容放在一个函数中（我喜欢@Roland's 中的名称scramble）：

scramble <- function(x, k=3) {
    x.s <- seq_along(x)
    y.s <- sample(x.s)
    idx <- unlist(split(y.s, (match(y.s, x.s)-1) %/% k), use.names = FALSE)
    x[idx]
}

scramble(x, 3)
# [1] 2 1 2 3 4 1 5 4 6 3
scramble(x, 3)
# [1] 1 2 2 1 4 3 6 5 4 3

为了进一步减少答案（并更快地获得），请遵循@flodel 的评论：

scramble <- function(x, k=3L) {
    x.s <- seq_along(x)
    y.s <- sample(x.s)
    x[unlist(split(x.s[y.s], (y.s-1) %/% k), use.names = FALSE)]
}

【讨论】：

如果数字确实重复，请将此函数应用于seq_along(x)，并使用输出索引x 和[。
@MatthewLundberg，太棒了！我会进行编辑（如果你没有打败我的话）。
看起来是个不错的解决方案。 @Arun 能否解释一下 Matthew 提到的 seq_along 输出
如果x是从1到n，那么结果是一个置换向量，但它也是对应的置换索引。因此，如果您的实际x 重复，我们可以创建一个新向量 1:n，然后创建这个可用于索引x 的置换索引。这有帮助吗？
我认为你不需要match。你可以做unlist(split(x[y], (y-1) %/% k), use.names = FALSE)。此外，如果k <- 3L（整数），事情应该会更快。

【解决方案3】：

作为记录，boot 包（随基本 R 一起提供）包含一个函数 permutation.array()，仅用于此目的：

x <- 1:100
k <- 3
ii <- boot:::permutation.array(n = length(x), 
                               R = 2, 
                               strata = (seq_along(x) - 1) %/% k)[1,]
x[ii]
#   [1]   2   1   3   6   5   4   9   7   8  12  11  10  15  13  14  16  18  17
#  [19]  21  19  20  23  22  24  26  27  25  28  29  30  33  31  32  36  35  34
#  [37]  38  39  37  41  40  42  43  44  45  46  47  48  51  50  49  53  52  54
#  [55]  57  55  56  59  60  58  63  61  62  65  66  64  67  69  68  72  71  70
#  [73]  75  73  74  76  77  78  79  80  81  82  83  84  86  87  85  89  88  90
#  [91]  93  91  92  94  95  96  97  98  99 100

【讨论】：

不错的解决方案。但我想指出这个功能效率低下（至少对于这个任务）。他们在strata 上使用table。这会很耗时，因为 x 很大并且有很多独特的条目。他们在内部对每个group 使用函数rperm，其中rperm 是sample0(x, length(x))。换句话说，他们也多次致电sample。在更大的x（甚至是 1e3 或 1e4，例如）上运行此函数可以清楚地显示差异。
@Arun -- 好的。我发布了另一个答案，速度很快，并致电sample() zero 次，我想你会很感激的。我认为这是目前最好的答案。你怎么看？
太棒了！是的，确实，这是最快和最好的答案。

【解决方案4】：

这将在末尾删除元素（带有警告）：

locality <- 3
x <- 1:100
c(apply(matrix(x, nrow=locality, ncol=length(x) %/% locality), 2, sample))
## [1]  1  2  3  4  6  5  8  9  7 12 10 11 13 15 14 16 18 17 19 20 21 22 24 23 26 25 27 28 30 29 32 33 31 35 34 36 38 39 37
## [40] 42 40 41 43 44 45 47 48 46 51 49 50 54 52 53 55 57 56 58 59 60 62 61 63 64 65 66 67 69 68 71 72 70 74 75 73 78 77 76
## [79] 80 81 79 83 82 84 87 85 86 88 89 90 92 93 91 96 94 95 99 98 97

【讨论】：

【解决方案5】：

v <- 1:16

scramble <- function(vec,n) {
  res <- tapply(vec,(seq_along(vec)+n-1)%/%n,
                FUN=function(x) x[sample.int(length(x), size=length(x))])
  unname(unlist(res))
}

set.seed(42)
scramble(v,3)
#[1]  3  2  1  6  5  4  9  7  8 12 10 11 15 13 14 16

scramble(v,4)
#[1]  2  3  1  4  5  8  6  7 10 12  9 11 14 15 16 13

【讨论】：

【解决方案6】：

我更喜欢 Matthew 的方法，但这是我解决问题的方法：

x <- 1:100
fact <- 3

y <- ceiling(length(x)/fact)

unlist(lapply(split(x, rep(1:y, each =fact)[1:length(x)]), function(x){
    if (length(x)==1) return(x)
    sample(x)
}), use.names = FALSE)

##   [1]   3   1   2   6   4   5   8   9   7  11  10  12  13  15  14  17  16  18
##  [19]  20  21  19  24  23  22  26  27  25  29  30  28  31  32  33  35  34  36
##  [37]  39  37  38  41  42  40  45  43  44  47  46  48  51  49  50  52  53  54
##  [55]  57  56  55  59  60  58  63  62  61  64  66  65  67  68  69  70  71  72
##  [73]  75  73  74  77  76  78  80  79  81  82  84  83  85  86  87  90  89  88
##  [91]  92  91  93  96  94  95  98  99  97 100

【讨论】：