Russian Roulette with adding new bullets in R

问题

I want to write a program in R for modificated Russian roulette. The first player has a revolver with 1 bullet. If he survive, we add one bullet to a chamber and spin the barrel. And so on, until the sixth player (if the others survive). I want to know a probability, that the revolver will come to the sixth player and I want to make it like a simulation. I know how to make a program for classical russian roulette

roulette <- function(numshots)
{
  killed = 6 
  killshots = 0
  won = 0
  i = 0
  while (killshots < numshots){
    shot = sample(1:6, size=1, replace=T) 
    i = i + 1  
    if (shot == killed)
    {
      killshots = killshots + 1
      if (i%%2 == 1)
      {
        won = won + 1
      }
    }
  }
  return(data.frame(A = won, B = numshots-won))
}
roulette(numshots)

and also for some other modifications, they are also here Creating a Russian roulette game in R But I don't know if it's useful for me the code for the classical russian roulette game. Can anyone help me please with the code in R?

回答1:

I suggest that that function is a little more cumbersome than necessary.

roulette1 <- function(bullets = 6L) {
  chamber <- sample(bullets)
  pick <- sample(bullets, replace=TRUE)
  for (i in 1:bullets) if (pick[i] %in% chamber[1:i]) break
  return(i)
}

Explanation:

pre-allocate the order of the chambers filled;
pre-allocate the order of the chambers chosen;
in the loop, check the ith pick with the chambers 1 through i, breaking out of the loop when a match is found;
after the for loop, i always indicates the first "success" (guaranteed, since by the end, all chambers are full)

Side notes:

we might be able to optimize this a little, since on the bulletsth loop, we know we will get success. It should not be necessary to do the test ... but it's cheap enough to just do it for now.
one of the differences (performance-wise) between my function and yours is that you are pulling the random numbers one at a time, which will slow things down a bit; in mine, I pull all chambers at once ... this will (about half the time) over-pull random data, but it results in around 34% faster runtime (empirically).

Sample run:

sample(6) # chamber
# [1] 4 2 1 3 5 6
sample(6) # pick, with possibly-repeated values
# [1] 1 3 2 5 2 2

i <- 1
1 %in% c(4) # FALSE

i <- 2
3 %in% c(4,2) # FALSE

i <- 3
2 %in% c(4,2,1) # TRUE

break

Therefore, in this sample, the for loop will break when i is 3, indicating that the "game" reached 3 trigger-pulls.

The return value is merely the number of steps before a single success. It's easy enough to calculate your A and B based off that. It's also trivial to determine the empirical probabilities:

set.seed(6)
roulettes <- replicate(1e6, roulette1())
# table(roulettes) / length(roulettes)
# str(data.frame(A = roulettes, B = 6L - roulettes))
# roulettes
#        1        2        3        4        5        6 
# 0.166374 0.278005 0.277309 0.185644 0.077301 0.015367 
'data.frame':   1000000 obs. of  2 variables:
#  $ A: int  2 1 3 5 6 5 4 3 4 1 ...
#  $ B: int  4 5 3 1 0 1 2 3 2 5 ...

(Updated to fix a sampling problem with pick, now the empirical probabilities marry up with the expected probabilities that Ell provided.)

回答2:

You can see my answer to a simple Russian Roulette game here. Adding to that we can make a function which plays Russian Roulette where, after each turn, a bullet is added and the barrel is spun.

I've modified this a bit from my original script (I realized it randomized the order of bullets in the chamber - as if the player removed all bullets and reloaded them each turn: the new version maintains structure with the player adding a bullet to the tested chamber after each non-lethal shot).

S in the function sets the capacity of the chamber, a 6-shooter is my default. All the function requires is P, a vector of players (or P1 - P6 as I've used to represent positions in the order of play).

RR <- function(P, S = 6){
    D <- 0
    i <- 1
    B <- 1

    # First player goes
    C <- sample(c(rep(1, times = B), rep(0, times = S-B)))

    # Did the first player die?
    if(C[1] == 1){
            D <- 1
            }

    # If player 1 survived...
    while(D != 1){
        i <- i + 1

        # Next player adds a bullet to the 1st empty chamber...
        C[1] <- 1

        # ...Spins the cylinder...
        R <- sample(seq(1,S))[1]
        C <- rep(C[c(R:S, 1:(R-1))], length.out = S)

        # ...Pulls the trigger
        if(C[1] == 1){
            D <- 1

        # If they survive, the gun goes to the next player (D remains 0, and until D = 1 the 'while' part will keep cycling through)
            }
    }   

    # The name/id of the loser is recorded
    L <- rep(P, length.out = i)[i]
    L
}

Here it is in action, simulated one million times:

# "Players"
P <- c("P1", "P2", "P3", "P4", "P5", "P6")

# Repeated simulations
n <- 1000000
RRres <- rep(NA, n)
for(i in 1:n){
    RRres[i]<- RR(P, S = 6)
}

# Observed frequencies
table(RRres)/n

The observed frequencies were:

> table(RRres)/n
RRres
      P1       P2       P3       P4       P5       P6 
0.166530 0.278042 0.277899 0.184914 0.077097 0.015518

This is very similar to the expected frequencies:

# Expected frequencies: 
# first term = probability of spinning on to a loaded chamber
# second term = probability of having to play
(P.P1 <- (1/6) * (6/6))
(P.P2 <- (2/6) * (6/6 * 5/6))
(P.P3 <- (3/6) * (6/6 * 5/6 * 4/6))
(P.P4 <- (4/6) * (6/6 * 5/6 * 4/6 * 3/6))
(P.P5 <- (5/6) * (6/6 * 5/6 * 4/6 * 3/6 * 2/6))
(P.P6 <- (6/6) * (6/6 * 5/6 * 4/6 * 3/6 * 2/6 * 1/6))


> P.P1
[1] 0.1666667
> P.P2
[1] 0.2777778
> P.P3
[1] 0.2777778
> P.P4
[1] 0.1851852
> P.P5
[1] 0.07716049
> P.P6
[1] 0.0154321

来源：https://stackoverflow.com/questions/49595214/russian-roulette-with-adding-new-bullets-in-r

标签

probability