# Tricky Simulation

#### WeeG

##### TS Contributor
Hi again, I got a tricky simulation to do in R...

In a kindergarden there are 12 kids. Every day at lunchtime, they sit randomly next to 3 tables, 4 kids next to each. What is the probabilty that in 10 days, each kid will sit at least once in the same table with each one of the other kids ?

hint: I need to use the function sample(), like: sample(1:10), .....

cheers

#### Tart

##### New Member
Hey WeeG,

I always hate those type of problems, combinatorics always gave me a headache, so, please verify everything I write below, I'm not entirely certain that what I do is right. Also, I think my way of solving this problem is not very good one, and maybe unnecessary complicated one. I'm very curious to see other solutions. Anyway check everything I do, see if it makes sense.

Code:
n.sim  <- 100 #number of simulations
n.times <- numeric(n.sim) #place holder for number of times each kid will sit
#at least once in the same table with each one of the other kids
# PRIME NUMBRS FOR KIDS ASSIGNMENTS
kids <- c(2,   3,  5,  7,
11, 13, 17, 19,
23, 29, 31, 37)

for (i in 1:n.sim){
table.1 <- matrix(0, 10, 4) #initiate table 1 10 days 4 kids
table.2 <- matrix(0, 10, 4) #initiate table 2 10 days 4 kids
table.3 <- matrix(0, 10, 4) #initiate table 3 10 days 4 kids

#populate Tables for 10 days
for (j in 1:10){
positions <- sample(kids, replace=FALSE)
table.1[j,] <-positions[1:4]
table.2[j,] <-positions[5:8]
table.3[j,] <-positions[9:12]
} # next j

Table <- data.frame(Table.1=apply(table.1, 1, prod),
Table.2=apply(table.2, 1, prod),
Table.3 =apply(table.3, 1, prod))
n.times[i] <- sum(diff(sort(rowSums(Table)))==0)

} # next i
Est.Prob <- sum(n.times)/n.sim
Now to explain what is going on in here.
First I assign kids first 12 prime numbers. Primes are really nice, if sums of primes are equal then all primes composing those sums are equal. Same true for products. I wanted to represent ordering by single number - so this is why I used primes. In Table variable I create a summary that holds all kids ordering for each table for 10 days. numbers are 'unique' since they are product of primes so if we encounter sum of these numbers at some other day, it means that kids are all the same at all tables. I'm doing this so I just have to compare singe number instead of 4 numbers (4 kids at table). Difference of sorted sum equal to zero will tell us how many times this happens in 10 days sum(diff(sort(rowSums(Table)))==0). I might be forgetting some of my number theory and some other math. But I think it is correct, or I hope it is

Once again, I'm sure there is a simple solution. This is just first thing that came to my mind, and I didn't explore other ways of solving it.

To make things fancy to to show convergence with increase of sample size
Code:
rm(list=ls())
# number of simulations
n.sims <- c(10, 50, 100, 250, 500, 1000, 1500, 2000, 3000, 5000, 7000, 10000)
Est.Prob <- numeric(length(n.sims))
kids <- c(2,   3,  5,  7,
11, 13, 17, 19,
23, 29, 31, 37)

for (i in 1:length(n.sims)){
n.sim <- n.sims[i]
n.times <- numeric(n.sim)
for (j in 1:n.sim){
table.1 <- matrix(0, 10, 4)
table.2 <- matrix(0, 10, 4)
table.3 <- matrix(0, 10, 4)

for (k in 1:10){
positions <- sample(kids, replace=FALSE)
table.1[k,] <-positions[1:4]
table.2[k,] <-positions[5:8]
table.3[k,] <-positions[9:12]
}   #next k

Table <- data.frame(Table.1=apply(table.1, 1, prod),
Table.2=apply(table.2, 1, prod),
Table.3 =apply(table.3, 1, prod))
n.times[j] <- sum(diff(sort(rowSums(Table)))==0)

} # next j
Est.Prob[i] <- sum(n.times)/n.sims[i]

} # next i

plot(Est.Prob~n.sims, type='o', pch=21, col='blue', bg='yellow',
ylab='Estimated Probability', xlab='Sample Size', ylim=c(0,0.05),
main='Add Title Here')

#### Mike White

##### TS Contributor
My attempt is shown below. I have used the combn function to get the permutaions of pairs at each table, these are then put in a matrix representing the number of meetings between each pair. If any pairs have not met after 10 days the corresponding matrix entry will be zero. The number of failures is then counted by checking the matrix for zeros after each simulation.

My results are slightly different so I may have made an error somewhere.

Code:
rm(list=ls())
# set seed so that same results can be reproduced
set.seed(1)

# give children names A to M
children<-LETTERS[1:12]
# set number of days
days<-10
# initiate variable to count days when children do not all meet each other
failures<-0
# set number of simulations
N<-1000

# set up loop for each simulation
for(n in 1:N){

# for each simulation set up matrix to record meetings between children
mat<-matrix(data=0, nrow=length(children), ncol=length(children))
colnames(mat)<-children
rownames(mat)<-children
# set diagonals to 1 - all children meet themselves!
diag(mat)<-1

for ( d in 1: days){
# select children for each table - could also use one sample of 12 and take 1:4, 5:8 and 9:12 for the tables
table1<-sample(children,4, replace=F)
table2<-sample(children[!children %in% table1], 4, replace=F)
table3<-children[!children %in% c(table1, table2)]

# determine pair combinations for Table 3 and put in upper and lower triangles of matrix
x<-combn(table1,2)
for (i in 1:ncol(x)){
mat[x[1,i],x[2,i]]<-mat[x[1,i],x[2,i]]+1
mat[x[2,i],x[1,i]]<-mat[x[2,i],x[1,i]]+1
}
# determine pair combinations for Table 3 and put in upper and lower triangles of matrix
x<-combn(table2,2)
for (i in 1:ncol(x)){
mat[x[1,i],x[2,i]]<-mat[x[1,i],x[2,i]]+1
mat[x[2,i],x[1,i]]<-mat[x[2,i],x[1,i]]+1
}
# determine pair combinations for Table 3 and put in upper and lower triangles of matrix
x<-combn(table3,2)
for (i in 1:ncol(x)){
mat[x[1,i],x[2,i]]<-mat[x[1,i],x[2,i]]+1
mat[x[2,i],x[1,i]]<-mat[x[2,i],x[1,i]]+1
} #

} # end for d

# check if any pairs of children have not met
failures<-failures+1*any(mat==0)
} # N
# estimate probability of all meeting each other
failures
# [1] 947

est.prob<-(N-failures)/N
est.prob
# [1] 0.053

#### Mike White

##### TS Contributor
Hi Tart
I have looked at your solution and have realised that our answers differ because we have different interpretations of the question!

I think that the question is ambiguous. I took the question to mean what is the probability of each of the 12 kids over 10 days will eventually have sat at any table with all the other 11 other kids.

#### Tart

##### New Member
each kid will sit at least once in the same table with each one of the other kids ?
I interpreted it as one of the arrangements repeated itself, in 10 days, with only difference in table, ie. Table1 - 1 2 3 4 Table2 - 5 6 7 8, Table3 9 10 11 12
same arrangement would repeat it self, 5 6 7 8 - 1 2 3 4- 9 10 11 12 but without specific table in mind.

#### WeeG

##### TS Contributor
hey !

thanks for trying ! I didn't have time to check your answers yet, I will do it later on today, just one thing about the question ( I saw it wasn't clear ). I need the probability that each one of the kids will sit at least once in the same table with each one of the other kids. At first he can sit with kid 1,3 and 5, on the next day with 2,7,8, and so on, after the time is over, he will sit at least once with each one of his classmates.

#### mp83

##### TS Contributor
I always hate those type of problems, combinatorics always gave me a headache
Yeah, I know how you feel...