运行飞机概率模拟

Running the airplane prob simulation

我正在尝试 运行 在 R 上进行模拟,但我卡住了;模拟与飞机概率问题的变体有关。

场景是这样的:一个100个座位的小剧场正在演出,随机给买票的客人分配一个座位号(从1-100),然后他们才走进去。总共有36位客人,他们通常坐在他们指定的座位上。如果由于某种原因他们的座位被占用,他们会随机选择另一个座位。参与演出的演员从 100 个座位中随机挑选一个座位,可能会占用已购票观众的编号座位,从而搞砸了。

我想在 R 上尝试 运行 这个并尝试回答问题:最后一个人坐错座位的概率是多少?平均大约有多少人会坐错座位?

有人可以帮我解决这个问题吗?我在下面添加了我的代码,我试图做的是找出最后一个人坐在错误座位上的概率......我认为我的代码中有错误,我希望 suggestions/help 可以让它变得更好!

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

这是我进行的模拟。 p 是演员移除座位的概率。您可以将其更改为 n 并删除函数中的 n <- floor(100 * p) 行。

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)))
}

要获得最后一个人坐错座位的概率,请重复此函数足够长的时间并取 $final 的平均值。比如让p = 0.3表示一个演员去掉30个席位,

dummy <- c()
for (i in 1:1000){
  dummy <- c(dummy, func(0.3)$final)
}
mean(dummy)
[1] 0.532

并得到“平均大约有多少人会坐错座位”,

dummy <- c()
for (i in 1:1000){
  dummy <- c(dummy, sum(func(0.3)$total))
}
mean(dummy)
[1] 11.7015

会做。

如果您需要有关代码的更多说明,请告诉我

我将随机坐在未售票座位上的任何人称为“漂浮者”。第一个漂浮物是演员。如果演员坐在某人的座位上,那个人就变成了漂浮者,等等。一些可以加快速度的观察:

  • 实际座位数positions/ordering不重要,重要的是客人入场顺序
  • 每个未占用的出票座位都有相等的概率让浮动者坐在其中
  • 漂浮者坐在另一位客人座位上的概率是未占用的出票座位数除以未占用的座位数
  • 预计 64% 的模拟复制会导致所有客人都坐在他们的售票座位上。不需要模拟其他复制。我们只需要模拟需要模拟的复制次数(通过rbinom)。

这让我们可以运行递归地模拟:

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)

我会 运行 一百万次复制。对于预期的 36% 的复制,演员将坐在客人的座位之一。对于这些复制,使用 sample 函数来模拟演员坐在谁的座位上(按照进入剧院的顺序)。然后用TheatreRecVec完成模拟,按列给出结果。请注意,对于所有这些复制,需要将第一个浮动项(在演员之后)添加到 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 

编辑以将模拟与精确解进行比较:

为了检查模拟结果,我们可以使用准确的值来表示最终坐错座位的客人的预期数量: digamma(s + 1) - digamma(s - g + 1) 其中 s 是剧院的座位数,g 是购票客人的数量。

> digamma(100 + 1) - digamma(100 - 36 + 1)
[1] 0.4434866

最后一次猜错座位的概率就是1/(s - g + 1)

> 1/(100 - 36 + 1)
[1] 0.01538462

这些与上面的模拟结果非常吻合。