6

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

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

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

4

6 回答 6

8

Arun 不喜欢我的另一个答案是多么低效,所以这里有一些非常适合他的东西;)

它只需要一次调用runif()and 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
于 2013-07-14T18:40:29.107 回答
7

一般解决方案:

编辑:正如@MatthewLundberg 评论的那样,我指出的“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

老答案:

这里的瓶颈是对 function 的调用量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

将所有内容放在一个函数中(我喜欢scramble@Roland 的名字):

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)]
}
于 2013-07-14T15:21:42.533 回答
5

作为记录,引导包(与基本 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
于 2013-07-14T16:08:10.900 回答
2

这将在最后删除元素(带有警告):

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
于 2013-07-14T15:19:17.183 回答
2
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
于 2013-07-14T15:24:58.073 回答
1

我更喜欢马修的方法,但这是我解决问题的方法:

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
于 2013-07-14T15:20:08.857 回答