CODEWITHSUNDEEP
rmatchrandom
Elizabeth
Elizabeth

Reputation: 6561

Creating multiple pairs in R

I have a list of people:

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

I would like to randomly assign two people to each person (self-assignment is not allowed) and I would like each person to be assigned to another an equal amount of times (in the example above each person can only be assigned to another twice).

So for example the match up could be

Betty (Joe and Bob), Joe (Bob and Will), Bob (Will and Frank), Will (Frank and Betty)

Of course I have just used their ordering but it would be nice if this could be randomised.

Any ideas where to start?

Upvotes: 3

Views: 162

Answers (2)

Arun
Arun

Reputation: 118789

New (easier) solution: Using shift function from TaRifx package from Ari B. Friedman

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"

Old solution (for the idea): I'd go this way. Basically, once you sample "people", you can always go, 1,2,3, 2,3,4, 3,4,5, 4,5,1. So, let's do that. That is, generate these indices and then sample people and get the triplets.

# 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"

Now we can put this all in a function:

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)

Upvotes: 3

Simon O&#39;Hanlon
Simon O&#39;Hanlon

Reputation: 59970

Interesting problem. This will get you half-way there. The bit that is missing is the constraint on people being in an equal number of partnerships. If you want to randomly assign two people to someone except themselves this can be achieved in a one liner like so...

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

First person will be assignee and last two will be assigned.

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"

Upvotes: 0

Related Questions