Выборка пар элементов из вектора, но без дублирования

Question

Скажем, у меня есть вектор четной длины, такой как:

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. В моем случае мне нужно делать это тысячи раз, и избежать дубликатов не так просто. Есть ли более эффективный способ?

Answer 1

Вот вариант вашего подхода "грубой силы" (более известного как "удар или промах"):

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)) занимает гораздо меньше секунды, чтобы бежать. С другой стороны, если у вас есть входные данные, для которых ограничения труднее удовлетворить, решение может потребовать больше времени.

Answer 2

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