Running the airplane prob simulation - r

Question

I'm trying to run a simulation on R but I'm quite stuck; The simulation has to do with a variation of the Airplane Probability problem.
This is the scenario: A small 100 seat theatre is conducting a play, and assigns a random seat number (from 1–100) to the ticketed guests right before they walk in. There are 36 guests in total, who usually sit in their assigned seats. If their seats are occupied for some reason, they choose another seat at random. An actor who is part of the play messes this up by picking a seat out of the 100 seats randomly, possibly taking a ticketed audience's numbered seat.
I want to try and run this on R and try and answer the questions: What is the probability that the last person is in the wrong seat? and On average, approximately how many people will sit in the wrong seat?
Could someone help me with this? I added my code below and what I attempt to do is find the probability that the last person is in the wrong seat... I think there are errors in my code and I would love some suggestions/help to make it better!
#Following are the 2 empty vectors which we will use later to store some probabilities and other stuff
Probregister <- c()
Register <- c()
Person <- c(1:36) #this vector creates 100 people standing in que from 1 to 100.
Seat <- sample(1:100, 100) #this vector allots each one of them a seat randomly. These are the assigned seats.
Actualseats <- c(1:100) #these are 100 empty seats in the theatre yet to be filled. Each entry is a seat no.
Actualperson <- rep(0,36) #This is an empty vector. Here we will know who is actually occupying the given Actualseat.
Data <- data.frame(Person, Seat, Actualseats, Actualperson)
Data$Actualperson[sample(1:100,1)] <- 1 #Selecting any seat from 100 empty seats in the theatre.
#this next loop cycles the decision procedure given in question from 2nd person to 36th person.
for(i in 2:36) {
if (Data$Actualperson[Data$Seat[i]] == 0) {
Data$Actualperson[Data$Seat[i]] <- i #If the seat assigned to ith person is empty then the person sits in it.
} else {
#This next line is very crucial piece and read it carefully.
#First square bracket selects only those seats which are empty. ie. Actualperson = 0
#Second square bracket randomly chooses 1 seat from these empty seats for ith person to sit in.
Data$Actualperson[which(Data$Actualperson == 0)][sample(1:length(Data$Actualperson[which(Data$Actualperson == 0)]), 1)] <- i #If their assigned seat is unavailable then they select randomly from remaining empty seats.
}
} #Here the loop ends for one trial. T
if(Data$Actualperson[Data$Seat[36]] == 36) {
Register <- append(Register, "Yes", after = length(Register)) #if 36th person is sitting in his alloted seat then add "Yes" to the Register.
} else {
Register <- append(Register, "No", after = length(Register)) #if 36th person is not sitting in his alloted seat then add "No" to the Register.
}
}
Probability <- length(Register[which(Register=="Yes")])/length(Register)
Probregister <- append(Probregister, Probability, after = length(Probregister))
}
Probsummary <- summary(Probregister)
plot(density(Probregister), col="red")
abline(v = Probsummary[3], col="blue")

Answer 1

This is a simulation I perform. p is probability that actor remove the seats. You may change this as n and remove n <- floor(100 * p) line in function.
func <- function(p){
x <- c(1:100) #stands for seats
y <- c(1:36) #stands for 36 person's seats, consider it as 1~36 cause it doesn't matter
correct <- rep(NA, 36) #dummy vector to record if person seat on correct seat
fin_passenger_dummy <- rep(NA,36) #dummy vector to record final passenger seat on correct seat
n <- floor(100 * p) #number of seats that an actor remove
yy <- sample(y, 36) #order of persons
actor <- sample(x, n) #id's of removed seats
seats <- setdiff(x, actor) #id's of remained seats
for (i in 1:36){
if (yy[i] %in% seats){
correct[yy[i]] <- TRUE #append that yy[i] seat on his seat
fin_passenger_dummy[i] <- TRUE #append that yy[i] seat on his seat
seats <- setdiff(seats, yy[i]) #update remaining seats
} else{
y_sad <- sample(seats, 1) #randomly choose seat to seat
correct[yy[i]] <- FALSE
fin_passenger_dummy[i] <- FALSE
seats <- setdiff(seats, y_sad)
}
}
return(list(total = correct, final = last(fin_passenger_dummy)))
}
To get the probability that the last person is in the wrong seat, replicate this function for enough time and take mean of $final. For example, letting p = 0.3 means an actor remove 30 seats,
dummy <- c()
for (i in 1:1000){
dummy <- c(dummy, func(0.3)$final)
}
mean(dummy)
[1] 0.532
And to get "On average, approximately how many people will sit in the wrong seat",
dummy <- c()
for (i in 1:1000){
dummy <- c(dummy, sum(func(0.3)$total))
}
mean(dummy)
[1] 11.7015
will do.
If you need more description about the code, pleas let me know

Answer 2

I'll refer to anyone that sits in a random unticketed seat as a "floater". The first floater is the actor. If the actor takes someone's seat, that person becomes the floater, etc. A few observations to speed things up:
The actual seats positions/ordering doesn't matter, only the order with which the guests enter the theatre
Each unoccupied ticketed seat has an equal probability that the floater will sit in it
The probability that the floater will sit in another guest's seat is the number of unoccupied ticketed seats divided by the number of unoccupied seats
An expected 64% of the simulation replications result in all guests sitting in their ticketed seats. The other replications don't need to be simulated. We need only simulate the number of replications that require simulation (via rbinom).
This lets us run the simulation recursively:
TheatreRec <- function(tickets, seats) {
# recursive function for simulating the theatre seating problem
# Inputs:
# tickets: the number of ticketed guests yet to be seated
# seats: the number of unoccupied seats remaining
# Output: an integer vector of length 2:
# 1: number of guests in the wrong seat
# 2: whether the last seated guest sits in the wrong seat (0 or 1)
# the floater sits in a random unoccupied seat
floater <- sample(seats, 1)
if (floater > tickets) {
# the floater didn't take anyone's seat
return(c(0L, 0L))
} else if (floater < tickets){
# the floater took one of the guests' seats, but not the last guest's seat
return(c(1L, 0L) + TheatreRec(tickets - floater, seats - floater))
} else {
# the floater took the last guest's seat
return(c(1L, 1L))
}
}
# create a vectorized version of TheatreRec
TheatreRecVec <- Vectorize(TheatreRec)
I'll run a million replications. For an expected 36% of the replications, the actor will sit in one of the guest's seats. For these replications, use the sample function to simulate whose seat the actor takes (in order of entry into the theatre). Then complete the simulation with TheatreRecVec, which gives the results column-wise. Note that for all of these replications, the first floater (after the actor) needs to be added to the results of TheatreRecVec.
floater <- sample(36, rbinom(1, 1e6, 0.36), replace = TRUE)
(results <- setNames(rowSums(rbind(1L, floater == 36) + TheatreRecVec(36L - floater, 100L - floater))/1e6, c("Avg. in wrong seat", "P(last guess in wrong seat)")))
Avg. in wrong seat P(last guess in wrong seat)
0.442944 0.015423
EDIT to compare the simulation to the exact solutions:
To check the simulation, we can use the exact value for the expected number of guests who end up in the wrong seat:
digamma(s + 1) - digamma(s - g + 1)
where s is the number of seats in the theatre, and g is the number of ticketed guests.
> digamma(100 + 1) - digamma(100 - 36 + 1)
[1] 0.4434866
The probability that the last guess ends up in the wrong seat is simply 1/(s - g + 1)
> 1/(100 - 36 + 1)
[1] 0.01538462
These match pretty closely with the simulation results above.