Создание нескольких пар в R

Question

У меня есть список людей:

people<-c("Betty", "Joe", "Bob", "Will", "Frank") 

Я хотел бы случайно назначить два человека к каждому человеку (самообеспечение назначение не допускается), и я хотел бы каждому человеку быть назначен на другое равное количество раз (в приведенном выше примере каждый человек может быть назначен только другому).

Так, например, матч вверх может быть

Бетти (Джо и Боб), Джо (Боб и Уилл), Боб (Will и Frank), Уилл (Фрэнк и Бетти)

я, конечно, просто использовали их порядок, но было бы неплохо, если бы это было рандомизировано.

Любые идеи, с чего начать?

Answer 1

Новое: Использование shift функции из пакета TaRifx от Ари Б. Фридман

tt <- sample(people) 
lapply(seq_len(length(tt))-1, function(x) shift(tt, x)[1:3]) 
# if you don't want it to be ordered, just add a sample(.) 
lapply(seq_len(length(tt))-1, function(x) sample(shift(tt, x)[1:3])) 
# [[1]] 
# [1] "Bob" "Frank" "Betty" 
# 
# [[2]] 
# [1] "Frank" "Betty" "Joe" 
# 
# [[3]] 
# [1] "Betty" "Joe" "Will" 
# 
# [[4]] 
# [1] "Joe" "Will" "Bob" 
# 
# [[5]] 
# [1] "Will" "Bob" "Frank" 

---

Старый раствор (за идею): Я бы иди этим путем. В принципе, как только вы sample «люди», вы можете всегда go, 1,2,3, 2,3,4, 3,4,5, 4,5,1. Итак, давайте сделаем это. То есть, сгенерируйте эти индексы, а затем опробуйте людей и получите триплеты.

# generate index 
len <- length(people) 
choose <- 3 # at a time 
idx <- outer(seq(choose), seq(choose+2)-1, '+') 
#  [,1] [,2] [,3] [,4] [,5] 
# [1,] 1 2 3 4 5 
# [2,] 2 3 4 5 6 
# [3,] 3 4 5 6 7 

# sample people 
tt <- sample(people) 
# [1] "Joe" "Will" "Bob" "Frank" "Betty" 
max.idx <- 2*choose + 1 
tt[(len+1):max.idx] <- tt[seq(max.idx-len)] 
# [1] "Joe" "Will" "Bob" "Frank" "Betty" "Joe" "Will" 

tt[idx] 
# [1] "Joe" "Will" "Bob" "Will" "Bob" "Frank" "Bob" "Frank" "Betty" "Frank" 
# [15] "Betty" "Joe" "Betty" "Joe" "Will" 

split(tt[idx], gl(ncol(idx), nrow(idx))) 
# $`1` 
# [1] "Joe" "Will" "Bob" 
# 
# $`2` 
# [1] "Will" "Bob" "Frank" 
# 
# $`3` 
# [1] "Bob" "Frank" "Betty" 
# 
# $`4` 
# [1] "Frank" "Betty" "Joe" 
# 
# $`5` 
# [1] "Betty" "Joe" "Will" 

Теперь мы можем поставить все это в функции:

my_sampler <- function(x, choose) { 
    len <- length(x) 
    idx <- outer(seq(choose), seq(choose+2)-1, '+') 
    sx <- sample(x) 
    max.idx <- 2*choose + 1 
    sx[(len+1):max.idx] <- sx[seq(max.idx-len)] 
    split(sx[idx], gl(ncol(idx), nrow(idx))) 
} 
# try it out 
my_sampler(people, 3) 
my_sampler(people, 4) # 4 at a time 

# if you want this and want a non-ordered solution, wrap this with `lapply` and `sample` 

lapply(my_sampler(people, 3), sample) 

Answer 2

Интересная проблема. Это поможет вам на полпути. Бит, который отсутствует, является ограничением для людей, находящихся в равном числе партнерств. Если вы хотите случайно назначить двух человек кому-то, кроме самих себя, это может быть достигнуто в один лайнер, как так ...

assigns <- lapply(people , function(x) { c(x , sample(people[!(people %in% x)] , 2)) }) 

Первый человек будет правопреемником и два последних будут назначены.

(проще) решение

assigns 
#[[1]] 
#[1] "Betty" "Bob" "Will" 

#[[2]] 
#[1] "Joe" "Bob" "Frank" 

#[[3]] 
#[1] "Bob" "Betty" "Joe" 

#[[4]] 
#[1] "Will" "Betty" "Joe" 

#[[5]] 
#[1] "Frank" "Will" "Betty"