r - 将每个值交换为不同的值

Question

下面是交换列表中小于 10 的值的交换函数

swapFun <- function(x, n = 10){
inx <- which(x < n)
x[sample(inx)] <- x[inx]
x
}

例如，原始列表是 1, 2, 3, 10, 4, 11。

通过采样交换后，这个列表可能是 2, 1, 4, 10, 3, 11 或 1, 3, 2, 10, 4, 11。

但我想将小于 10 的每个值交换为小于 10 的不同值。

例如，第一个结果(即 2, 1, 4, 10, 3, 11)就是我想要的，因为每个小于 10 的值都被交换为小于 10 的不同值。

然而，第二个结果(即 1, 3, 2, 10, 4, 11.)不是我想要的，因为 1 和 4 尚未交换为小于 10 的不同值。

如果没有可行的解决方案，只需打印“无可行的解决方案”

有什么建议？
非常感谢。

Answer 1

您正在寻找 derangement小于 10 的值。根据乱序理论，随机选择的排列中大约有 1/e (37%) 是乱序，因此命中或未命中方法是合理的，但有一个重要的警告。

小于 n 的项目之间可能存在重复.并非这些项目的所有排列都是可区分的，因此并非所有项目的困惑看起来都像困惑:将两个 2 相互交换(例如)在某种意义上是困惑，但它看起来不像是困惑。 1/e启发式适用于位置的原始排列，而不是可区分的值排列。如果重复次数很高，则可能需要比 1/e 建议的更长的时间。如果在您的用例中性能不令人满意，您需要更换 sample()在函数定义中由一个更复杂的函数选择随机可区分的排列。

就可行性而言，只要最常见的元素小于n，就会有一个可行的解决方案。不占n以下项目的50%以上

derangement <- function(x){
  if(max(table(x)) > length(x)/2) return(NA)
  while(TRUE){
    y <- sample(x)
    if(all(y != x)) return(y)
  }
}

swapFun <- function(x, n = 10){
  inx <- which(x < n)
  y <- derangement(x[inx])
  if(length(y) == 1) return(NA) 
  x[inx] <- y
  x
}

例如，

> set.seed(10)
> swapFun(c(1,2,10,4,11,2,12))
[1]  2  4 10  2 11  1 12
> swapFun(c(2,2,10,4,11,2,12))
[1] NA

请注意，没有有效的乱序长度为 1，但 NA长度为 1，所以测试 y 的长度是测试是否有可能使值困惑的有效方法。函数返回 NA如果不存在小于 n 的值的困惑。如果需要，您可以测试 NA 并打印“没有可行的解决方案”