View Full Version : Tricky Simulation

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

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.

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

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

06-23-2009, 03:30 AM

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.

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

06-23-2009, 05:52 AM

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.

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.

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.

I always hate those type of problems, combinatorics always gave me a headache

Yeah, I know how you feel...

Powered by vBulletin™ Version 4.1.3 Copyright © 2015 vBulletin Solutions, Inc. All rights reserved.