从向量中采样元素对但不重复答案

【问题标题】：Sampling pairs of elements from a vector but without duplication从向量中采样元素对但不重复
【发布时间】：2018-11-06 18:52:05
【问题描述】：

假设我有一个偶数长度的向量，例如：

v <- c(1,1,1,1,2,2,2,3,3,3,4,5,6,7)

它有 14 个元素长。我希望随机抽取 7 对元素而不进行替换，但规则是任何对都不应包含两个相同的项目。

所以下面的结果是可以接受的：

1-2, 1-2, 1-2, 1-3, 3-4, 3-5, 6-7

我不确定如何系统地执行此操作。显然蛮力会起作用，例如

set.seed(1)
v=c(1,1,1,1,2,2,2,3,3,3,4,5,6,7)
length(v)
v1<-sample(v)
pairs <- split(v1, ceiling(seq_along(v1)/2))
sapply(pairs, diff)

 1  2  3  4  5  6  7 
 1  1  2  3 -6 -3  3

这表明没有一对有重复元素，因为差异总是不为 0。在我的情况下，我需要这样做 1000 次，避免重复并不容易。有没有更有效的方法？

【问题讨论】：

那只会给我一对。我需要所有 14 个元素来形成 7 对，其中没有一对具有相同的元素两次。
unique(v) 是否打破了您对频率的假设？也就是说，您是否期望采样返回 1 是 7 的四倍？
@r2evans 是的，返回的对集合需要每个元素的频率与原始向量相同。这就是replicate(7,sample(unique(v),2)) 不起作用的原因——因为它是替换抽样。我需要不更换样品。
您似乎不想要一个随机样本，而是一个受约束的随机分区
你区分 1-2 和 2-1 对吗？您可以将其建模为构造随机图之一，其中顶点为unique(v)，v 中每个元素的计数是结果图中这些元素的度数（或有向图，如果顺序很重要）。

标签： r

【解决方案1】：

v0 <- table(v)
set.seed(2)
out <- replicate(7, sample(names(v0), size=2, prob=v0))
out
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,] "1"  "2"  "4"  "1"  "3"  "2"  "6" 
# [2,] "5"  "1"  "7"  "7"  "2"  "1"  "1"

我使用table(v) 和names(v0) 以保证名称和概率的顺序相同。（我不想假设您的实际数据结构相同。）如果您需要整数，那么对我们来说很容易as.integer。

如果你真的需要1-2，那么

apply(out, 2, paste, collapse="-")
# [1] "1-5" "2-1" "4-7" "1-7" "3-2" "2-1" "6-1"

我相信这不会产生任何欺骗（因为names(v0) 是唯一的并且默认为replace=FALSE），但这是一个经验测试：

set.seed(3)
l <- replicate(1e5, sample(unique(v), size=2, prob=table(v)))
any(l[1,] == l[2,])
# [1] FALSE

【讨论】：

由于您的解决方案涉及7 选择了两次，因此它不是没有替换的示例。
不是7选了两次，是v0的样本，选了两次没有放回，然后重复了7次。七个 pairs 之间可能存在重复，但任何一对中都没有重复。（基于sample(..., replace=FALSE) 是正确的假设，我认为可以肯定地说“在对中从不重复”。）您是否在考虑而不是replicate(2, sample(v0, size=7, replace=TRUE))？
也许 OP 需要澄清一下。我对它的解读是，他们希望将这 14 个元素排列成 7 对，这样任何对都不包含重复项。如果是这样，您的解决方案不能满足这一点。它们似乎具有 1、2 等的精确频率，而不是以某种方式加权的分布。如果我的阅读是正确的，我看不到一个简单的解决方案。
肯定有相同的对（在我的极端例子中是1e5 - 7*6），但在一对中绝不会有任何重复。也许这有助于澄清：我是说我永远不会看到1-1，尽管我很可能会得到c("1-2", "1-2")。
我不反对，但这不是重点。您的 7 对集合有 5 个 1、3 个 2、3、4、5、6 各一个，2 个 7 的 OP 似乎需要 4 个 1、3 个 2、3 个 3 和 4、5、6、7 各一个.他正在寻找将 14 个元素划分为 7 个 2 元素单元格，其中没有单元格包含重复项。

【解决方案2】：

这是您的“蛮力”方法的一种变体（通常称为“命中或未命中”）：

rand.pairs <- function(v, time.out = 1000){
  n <- length(v)
  for(i in 1:time.out){
    v <- sample(v)
    first <- v[1:(n/2)]
    second <- v[(n/2+1):n]
    if(all(first != second)) return(unname(rbind(first,second)))
  }
  NULL
}

time.out 的重点是避免无限循环。对于某些输入向量，解决方案可能是不可能的或太难偶然找到。

示例运行：

> v <- c(1,1,1,1,2,2,2,3,3,3,4,5,6,7)
> set.seed(1234)
> rand.pairs(v)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    6    3    3    7    2    2    5
[2,]    1    4    1    1    3    1    2

足够快，可以运行数千次：

> library(microbenchmark)
> microbenchmark(rand.pairs(v))
Unit: microseconds
          expr min    lq     mean median     uq    max neval
 rand.pairs(v) 6.7 7.758 16.17517 12.166 19.747 70.877   100

您的里程可能会有所不同，但如果您的机器具有可比性，您应该能够每秒调用此函数超过 50,000 次。 replicate(10000,rand.pairs(v)) 运行时间不到一秒。另一方面，如果您有一个难以满足约束条件的输入，则解决方案可能需要更多时间。

【讨论】：