How to simulate a martingale process problem in R?-CodePudding

100 people are watching a theater.At the end of the show all of them are visiting the vesting room in order to take their coats.The man working on the vesting room give back people's coat totally at random.The participants that they will pick the right coat leave.The other that have picked the wrong one, give back the coat and the man again randomly gives back the coat.The process ends when all the customers of the theater take back their right coat.

I want to simulate in R this martingale process in order to find the expected time that this process will end. But I don't know how .Any help ? Something like:



# 100 customers
x = seq(1,100,by=1);x
# random sample from x 
y = sample(x,100,replace=FALSE)
x==y
# for the next iteration exclude those how are TRUE and run it again until everyone is TRUE

The expected time is how many iterations where needed .

Or something like this :


n = 100
X = seq(1,100,by=1)
martingale = rep(NA,n)

iterations = 0
accept     = 0
while (X != n) {
  iterations =  iterations   1
  y = sample(1:100,100,replace=FALSE)
  if (X = y){ 
    accept = accept   1
    X = X 1
    martingale [X] = y
  }
}
accept
iterations

CodePudding user response：

One way to do this is as follows (using 10 people as an example, the print statement is unnecessary, just to show what's done in each iteration):

set.seed(0)
x <- 1:10
count <- 0
while(length(x) > 0){
  x <- x[x != sample(x)]
  print(x)
  count <- count   1
}

# [1]  1  2  3  4  5  6  7  9 10
# [1] 3 4 5 6 7 9
# [1] 3 4 5 6 7
# [1] 3 4 5 6 7
# [1] 3 4 5 6 7
# [1] 3 4 5 6 7
# [1] 3 4 5 6 7
# [1] 3 4 5 6 7
# [1] 3 6
# 
count
# [1] 10

For each step in the loop, it removes the values of x where the customers have been randomly allocated their coat, until there are none left.

To use this code to get the expected time taken for 100 people, you could extend it to:

set.seed(0)
nits <- 1000 #simulate the problem 1000 times
count <- 0
for (i in 1:nits){
  x <- 1:100
  while(length(x) > 0){
    x <- x[x != sample(x)]
    count <- count   1/nits
  } 
}
count
# [1] 99.901

I hypothesise without proof that the expected time for n people is n iterations - it seems pretty close when I tried with 50, 100 or 200 people.

CodePudding user response：

I didn't follow your discussion above and I'm not entirely sure if that's what you want, but my rationale was as follows:

You have N people and queue them.
In the first round the first person has a chance of 1/N to get their clothes right.
At this point you have two options. Eitehr person 1 gets their clothes right or not.
If person 1 gets their clothes right, then person 2 has a chance of 1/(N-1) to get their clothes right. If person 1 didn't get the correct clothes, person 1 remains in the pool (at the end), and person 2 also has a 1/N probability to get their clothes right.
You continue to assign thes probabilities until all N persons have seen the clerk once. Then you sort out those who have the right clothes and repeat at step 1 until everyone has their clothes right.
For simulation purposes, you'd of course repeat the whole thing 1000 or 10000 times.

If I understand you correctly, you are interstes in the number of iterations, i.e. how often does the clerk have to go through the whole queue (or what remains of it) until everyone has their clothes.

library(tidyverse)

people <- 100
results <- data.frame(people     = 1:people,
                      iterations = NA)

counter <- 0
finished <- 0

while (finished < people)
{
  loop_people <- results %>%
    filter(is.na(iterations)) %>%
    pull(people)

  loop_prob <- 1/length(loop_people)
  loop_correct <- 0

  for (i in 1:length(loop_people))
  {
    correct_clothes_i <- sample(c(0,1), size = 1, prob = c(1-loop_prob, loop_prob))
    if (correct_clothes_i == 1)
    {
      results[loop_people[i], 2] <- counter   1
      loop_correct <- loop_correct   1
      loop_prob <- 1/(length(loop_people) - loop_correct)
    }
  }
  counter <- counter   1
  finished <- length(which(!is.na(results$iterations)))
}

max(results$iterations)

[1] 86

head(results)

  people iterations
1      1          7
2      2         42
3      3         86
4      4         67
5      5          2
6      6          9

The results$iterations column contains the iteration number where each person has gotten their clothes right, thus max(results$iterations) gives you the total number of loops.

I have no proof, but empirically and intuitively the number of required iterations should approach N.