在 R 中有效地创建向量的紊乱

Question

我正在研究一种在 R 中有效地创建向量的混乱（以及相反的特定排列）的方法。 据我所见，没有可以做到这一点的基本功能，而且在 SO 上也没有太多关于它的内容。

一个明显的开始是sample，它创建了一个向量的排列。但是我需要这种排列没有固定点，因此是向量的紊乱。有关此主题的详细说明，请参阅 this Cross Validated post。

这是我的第一种方法：

derangr <- function(x){

  while(TRUE){

    xp <- sample(x)

     if(sum(xp == x) == 0) break

  }

  return(xp)

}

所以在while 循环中，我正在检查向量x 和x 的给定排列之间是否存在一个固定点，称为xp。如果没有，我打破循环并返回向量。

结果显示，它运行良好：

> derangr(1:10)
 [1]  4  5  6 10  7  2  1  9  3  8

> derangr(LETTERS)
 [1] "C" "O" "L" "J" "A" "I" "Y" "M" "G" "T" "S" "R" "Z" "V" "N" "K" "D" "Q" "B" "H" "F" "E" "X" "W" "U" "P"

所以我想知道是否有更好的方法来做到这一点，可能用某种矢量化替代while。我还想关注可扩展性。

这是两个示例的microbenchmark：

library(microbenchmark)

> microbenchmark(derangr(1:10),times = 10000)
Unit: microseconds
          expr   min     lq    mean  median      uq      max neval
 derangr(1:10) 8.359 15.492 40.1807 28.3195 49.4435 6866.453 10000

> microbenchmark(derangr(LETTERS),times = 10000)
Unit: microseconds
             expr    min     lq     mean  median      uq      max neval
 derangr(LETTERS) 24.385 31.123 34.75819 32.4475 34.3225 10200.17 10000

同样的问题也适用于相反的情况，产生具有给定数量的固定点n的排列：

arrangr <- function(x,n){

  while(TRUE){

    xp <- sample(x)

     if(sum(xp == x) == n) break
  }

  return(xp)

}

Answer 1

如果您没有唯一的值，您可以重新排列索引，并将其用于以新顺序对输入向量进行子集化。在这种情况下，如果您有例如rep(LETTERS, 2)，第一个A 和第二个A 将可以互换。 Q 中提出的derangr() 函数也会重新排列这些。

derangr2 <- function(x){
  ind <- seq_along(x)
  while(TRUE){
    indp <- sample(ind)
    if(sum(indp == ind) == 0) break

  }
  return(x[indp])
}

一些基准测试结果：

microbenchmark(derangr(rep(LETTERS, 4)), 
               derangr2(rep(LETTERS, 4)), times = 1000)

# Unit: microseconds
#                      expr   min       lq       mean  median      uq      max neval
#  derangr(rep(LETTERS, 4)) 6.258 113.4895 441.831094 251.724 549.384 5837.143  1000
# derangr2(rep(LETTERS, 4)) 6.542   7.3960  23.173800  12.800  22.755 4645.936  1000

但是，如果您只面对独特的价值观，这种方法并没有太大的改进。

microbenchmark(derangr(1:1000), derangr2(1:1000), times = 1000)
# Unit: microseconds
#             expr    min     lq     mean median      uq      max neval
#  derangr(1:1000) 19.341 21.333 61.55154 40.959 78.0775 2770.382  1000
# derangr2(1:1000) 23.608 25.884 72.76647 46.079 84.1930 2674.243  1000