Creating a Russian roulette game in R - r

I wonder if anyone could help me to create a russian roulette game in R? I'm a total novice at R and at writing code in general. I would be very grateful for your help!
The game is played with a revolver equipped with a rotatable magazine of six shots. The revolver is loaded with one shot. The first duellist, A, rotates the magazine at random, points the revolver at his head and presses the trigger. If, afterwards, he is still alive, he hands the revolver to the other duellist, B, who acts in the same way as A. The players shoot alternately in this manner,
until a shot goes off.
All I (with help) have come up with so far is:
shot<-runif(1,min=0,max=1)
killed<-runif(1,min=0,max=1/6)
roulette<-function()
{
while (shot!=killed)
{
shot <- runif(1,min=0,max=1)
print("click")
if (shot<killed)
break
}
{
print ("Dead")
}
}
for (i in 1:5)
{
roulette()
}
How do I count the number of times A or B has been killed in e g 1000 games? Some variable which can switch between A and B and then store the results in a list?

You can use the while statement and count the number of iterations.
Odd number of shots fired = A dies, even number of shots fired = B dies
n <- 1000
outcomes <- cbind(rep("click",n),rep("click",n),numeric(length=n),numeric(length=n))
colnames(outcomes) <- c("finalA","finalB","nClickA","nClickB")
for (i in 1:nrow(outcomes)){
shot<-runif(1,min=0,max=1) #first shot
count <- 1
while (shot > 1/6) { #chance of dying is 1/6, so every 0 < shot < 1/6
#will be considered "death"
shot <- runif(1,min=0,max=1) #if not dead, shoot again
count <- count + 1 #and count the iterations
}
#replace "click" by "dead" for either A or B
ifelse ((count %% 2) > 0, #if count is odd number = A killed, else: B killed
(outcomes[i,1] <- "dead"), #replace the "click"s in outcomes matrix
(outcomes[i,2] <- "dead"))
#count and insert the number of clicks for each player
#if count = odd number, both had (count/2)-1 clicks
nclick <- count- 1 #the number of clicks is always the number of triggerpulls minus 1
if ((nclick %% 2) == 0) {outcomes[i,3:4] <- nclick/2
#if nclick is even number, both A and B took (nclick/2) clicks
} else {
outcomes[i,3] <- nclick/2+0.5
outcomes[i,4] <- nclick/2-0.5}
#if nclick is odd number, A took one click more than B
}
outcomes <- as.data.frame(outcomes)
table(outcomes$finalA)
table(outcomes$finalB)
Edit: If the probability of dying is not the same for each A and B, you could include an if-statement with different death probabilities inside the while loop, which will terminate once either A or B dies (death=TRUE).
shot <- runif(1,min=0,max=1) #first shot
count <- 1
death <- logical(length=1) #new object needed to terminate the while-loop
if (shot < 0.6) {death <- TRUE} #A is already dead with p=.60
while (death != TRUE) { #if A survived the first trigger-pull, start while-loop
if (count %% 2 == 1) { #if count is odd, it's B's turn
shot <- runif(1,min=0,max=1) #next trigger-pull
if (shot < 0.8) {death <- TRUE} #B's probability of dying is .80
count <- count + 1
} else { #if count is even, it's A's turn again
shot <- runif(1,min=0,max=1)
if (shot < 0.6) {death <- TRUE}
count <- count +1
} #and this loop goes on until death = TRUE
}
Edit: What if the bullets are in adjacent chambers?
If the bullets are in adjacent chambers, there are six possibile positions, two covering each chamber. First trigger-pull has p(death)=2/6. If no shot was fired, we know neither of the two bullet positions was true, to next triggerpull has p(death)=1/4, and so on.
count <- 1
k <- 5
death <- sample(c(T,T,F,F,F,F)[1:k],1)
while (death != TRUE){k <- k-1
death <- sample(c(T,F,F,F)[1:k],1)
count <- count +1}

I understand the model to be "keep trading the gun back and forth until numshots number of shots are fired". I modeled the loaded chamber like the roll of a die, setting "6" to be the fatal roll
roulette <- function(numshots=1000){
killed = 6 # fatal face on a die
killshots = 0
won = 0
i = 0
while (killshots < numshots){
shot = sample(1:6, size=1, replace=T) # rolling a die
i = i + 1 # keep track of even or odd # of tries
if ( (shot == killed) ){
killshots = killshots + 1
if (i%%2 == 1){
won = won + 1
}
}
}
return(data.frame(A = won, B = numshots-won))
}
> roulette()
A B
1 502 498

I was looking at another post earlier this morning about a more complex Russian Roulette game in R, and decided to make a function for a simple version. In your example, you have "shuffling" because the chamber is spun before each turn.
RR <- function(PLAYERS, S = 6){
D <- 0
i <- 0
while(D != 1){
P <- sample(c(1, rep(0, times = S-1)))[1]
i <- i + 1
if(P == 1){
D <- 1
}
}
L <- rep(PLAYERS, length.out = i)[i]
L
}
In this function the while argument is utilized to play rounds until someone wins; S is the amount of chambers in the gun, and is set to 6 as default to make this a 6-shooter, D is coding whether a player has died (1) or not (0), i is the round of the game, P is the random position of the bullet in the chamber, and if P = 1 (the bullet is in the first chamber after spinning), the player dies and the game is over. The loser (L) is assigned and printed.
It appears that Clint Eastwood and John Wayne fancy a game...
> PLAYERS <- c("Eastwood", "Wayne")
> RR(PLAYERS)
[1] "Wayne"
But what happens over 10000 games?
> n <- 10000
> RRres <- rep(NA, times = n)
>
> for(i in 1:n){
+ RRres[i] <- RR(PLAYERS)
+ }
>
> table(RRres)
RRres
Eastwood Wayne
5393 4607
It looks like Clint shouldn't feel so lucky himself... but that's because he is always going first: there is an advantage in going last when you shuffle the chamber, because if the player(s) before you die, you don't play - it's more likely that a game will be over in few rounds than in many (Probability that a given round [n] results in the killshot = (1/6) * ((5/6)^n), where 1/6 is the risk of shuffling on to the loaded chamber, and (5/6)^n is the probability that someone already lost).
Therefore, you might want to randomize the order of players in each game using the sample function:
> for(i in 1:n){
+ RRres[i] <- RR(sample(PLAYERS))
+ }
>
> table(RRres)
RRres
Eastwood Wayne
5017 4983
Note that this function works for any amount of players (e.g. 26 players):
> for(i in 1:n){
+ RRres[i] <- RR(sample(LETTERS[1:26]))
+ }
>
> table(RRres)
RRres
A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
396 362 378 368 373 388 383 398 390 372 379 382 395 393 377 389 381 386 375 379 375 382 379 430 393 397

Related

Faster ways to generate Yellowstone sequence (A098550) in R?

I just saw a YouTube video from Numberphile on the Yellowstone sequence (A098550). It's base on a sequence starting with 1 and 2, with subsequent terms generated by the rules:
no repeated terms
always pick the lowest integer
gcd(a_n, a_(n-1)) = 1
gcd(a_n, a_(n-2)) > 1
The first 15 terms would be: 1 2 3 4 9 8 15 14 5 6 25 12 35 16 7
A Q&D approach in R could be something like this, but understandably, this becomes very slow at attempts to make longer sequences. It also make some assumptions about the highest number that is possible within the sequence (as info: the sequence of 10,000 items never goes higher than 5000).
What can we do to make this faster?
library(DescTools)
a <- c(1, 2, 3)
p <- length(a)
# all natural numbers
all_ints <- 1:5000
for (n in p:1000) {
# rule 1 - remove all number that are in sequence already
next_a_set <- all_ints[which(!all_ints %in% a)]
# rule 3 - search the remaining set for numbers that have gcd == 1
next_a_option <- next_a_set[which(
sapply(
next_a_set,
function(x) GCD(a[n], x)
) == 1
)]
# rule 4 - search the remaining number for gcd > 1
next_a <- next_a_option[which(
sapply(
next_a_option,
function(x) GCD(a[n - 1], x)
) > 1
)]
# select the lowest
a <- c(a, min(next_a))
n <- n + 1
}
Here's a version that's about 20 times faster than yours, with comments about the changes:
# Set a to the final length from the start.
a <- c(1, 2, 3, rep(NA, 997))
p <- 3
# Define a vectorized gcd() function. We'll be testing
# lots of gcds at once. This uses the Euclidean algorithm.
gcd <- function(x, y) { # vectorized gcd
while (any(y != 0)) {
x1 <- ifelse(y == 0, x, y)
y <- ifelse(y == 0, 0, x %% y)
x <- x1
}
x
}
# Guess at a reasonably large vector to work from,
# but we'll grow it later if not big enough.
allnum <- 1:1000
# Keep a logical record of what has been used
used <- c(rep(TRUE, 3), rep(FALSE, length(allnum) - 3))
for (n in p:1000) {
# rule 1 - remove all number that are in sequence already
# nothing to do -- used already records that.
repeat {
# rule 3 - search the remaining set for numbers that have gcd == 1
keep <- !used & gcd(a[n], allnum) == 1
# rule 4 - search the remaining number for gcd > 1
keep <- keep & gcd(a[n-1], allnum) > 1
# If we found anything, break out of this loop
if (any(keep))
break
# Otherwise, make the set of possible values twice as big,
# and try again
allnum <- seq_len(2*length(allnum))
used <- c(used, rep(FALSE, length(used)))
}
# select the lowest
newval <- which.max(keep)
# Assign into the appropriate place
a[n+1] <- newval
# Record that it has been used
used[newval] <- TRUE
}
If you profile it, you'll see it spends most of its time in the gcd() function. You could probably make that a lot faster by redoing it in C or C++.
The biggest change here is pre-allocation and restricting the search to numbers that have not yet been used.
library(numbers)
N <- 5e3
a <- integer(N)
a[1:3] <- 1:3
b <- logical(N) # which numbers have been used already?
b[1:3] <- TRUE
NN <- 1:N
system.time({
for (n in 4:N) {
a1 <- a[n - 1L]
a2 <- a[n - 2L]
for (k in NN[!b]) {
if (GCD(k, a1) == 1L & GCD(k, a2) > 1L) {
a[n] <- k
b[k] <- TRUE
break
}
}
if (!a[n]) {
a <- a[1:(n - 1L)]
break
}
}
})
#> user system elapsed
#> 1.28 0.00 1.28
length(a)
#> [1] 1137
For a fast C++ algorithm, see here.

Find perfect number using while loop in R

I was trying to find perfect number.
Perfect number is that the sum of its factors(including 1) equals itself.
I need to find the first and second perfect number 6 and 28.
So I start from number 2 until I find 2 perfect numbers.
Here is the code:
num.perfect <- 2
count <- 0
iter <- 2
while(count < num.perfect)
{
divisor <- 1
for(i in 2:iter) #find the factors of a number
{
if(iter%%i==0)
{
divisor <- c(divisor, i)
}
}# end for loop
if(sum(divisor)==iter) #print the perfect number
{
print(paste(iter, " is a perfect number", sep=""))
count <- count + 1
} # end if
iter <- iter +1
} # end while loop
But the loop keeps running and will not stop. What is wrong with my code?
You can try this code and see whether it does what you want:
facs=function(n) head((1:n)[n%%(1:n)==0],-1)
perf=function(x){
k=numeric(x)
m=i=0
while(m<x){
i=i+1
if(sum(facs(i))==i){m=m+1;k[m]=i}
}
k
}
perf(4)
# [1] 6 28 496 8128

Simulation loops for R Ping Pong

I need to find the probability Pr(X = i), i = 2, . . . , 6, by simulation using R when two players A and B agree that the winner of a game will get 1 point and the loser 0 points; the match ends as one of the players is ahead by 2 points or the number of games reaches 6. Suppose that the probabilities of A and B winning a game are 2 3 y 1 3 , respectively, and each game is independent. Let X denote the number of games needed to end the game.
I am applying the following code:
juegos<-rbinom(6,1,2/3)
juegos
A<-cumsum(juegos)
B<-cumsum(1-juegos)
K<-abs(A-B)==2
R<-rep(0,1000)
for(i in 1:1000)
{R[i]<-which.max(K)}
R
However I donĀ“t know what is the next step to find the probabilities when i=2, 4 and 6.
Here is one way that uses a function to simulate a single match:
# Function to simulate one match
one_match = function(p = 2/3){
g = 0
score = 0
while (g < 6){
g = g + 1
# Play one game & update score
if (runif(1) < p)
score = score + 1
else
score = score - 1
if (abs(score) == 2) break
}
return(g)
}
# Simulate matches
n_sims = 100000
outcomes = replicate(n_sims, one_match())
# Or, with a different winning probability, say p = 1/2
# outcomes = replicate(n_sims, one_match(p = 1/2))
# Estimate probabilities
probs = table(outcomes)/n_sims
print(probs)
Cheers!

Gambling algorithm

I have a hard time figuring out how to write a program in R.
I am suppose to bet 1$ on red, if I win I get 1$ and bet again, if I lose I double my bet. The program supposed to run until I win 10$ or bet becomes greater than 100.
Here is my code:
W=0
B=1
for(i=sample(0:1,1)){
B<-1
W<-0
while(W<10 & B<=100){
if(i=1){
W<-W+B
B<-B
}else{
B<-2*B
}
print(B)
}
}
i determines if I lose or win. And I use print(B) to see the if program runs. At this point it doesn't, B just equals 1 no matter what.
To make the consequences of such gambling more obvious we can modify this program adding variables to store the total Win/Lose and the dynamics of this number.
W_dyn <- c() # will store cumulative Win/Lose dynamics
W. <- 0 # total sum of Win/Lose
step <- 0 # number of bet round - a cycle of bets till one of
# conditions to stop happen: W > 10 or B >= 100
while (abs(W.) < 1000)
{ B <- 1
while (W < 10 & B <= 100)
{ i <- sample(0:1, 1)
if (i == 1)
{ W <- W + B
B <- 1
} else
{ W <- W - B
B <- 2 * B
}
print(B)
}
W. <- W. + W
W <- 0
step <- step + 1
W_dyn[step] <- W.
cat("we have", W., "after", step, "bet rounds\n")
}
# then we can visualize our way to wealth or poverty
plot(W_dyn, type = "l")
BTW, with condition of maximum possible B < Inf such gambling is always a waste of money in long run.
Your for loop doesn't make sense in this context. You should take another sample each time in the while loop.
B = 1
W = 0
while(W<10 & B<=100){
i=sample(0:1,1)
if(i==1){
W<-W+B
B<-B
}else{
B<-2*B
}
print(B)
}
Also, in your original for loop you needed an extra right parentheses ) after the sample(0:1,1) before the loop started. Without it, the program doesn't run as expected.
Also, you should use == instead of = when describing logical equalities.

pick a random number, always with increasing value over last random number picked

How would I efficiently go about taking a 1-by-1 ascending random sample of the values 1:n, making sure that each of the randomly sampled values is always higher than
the previous value?
e.g.:
For the values 1:100, get a random number, say which is 61. (current list=61)
Then pick another number between 62 and 100, say which is 90 (current list=61,90)
Then pick another number between 91 and 100, say which is 100.
Stop the process as the max value has been hit (final list=61,90,100)
I have been stuck in loop land, thinking in this clunky manner:
a1 <- sample(1:100,1)
if(a1 < 100) {
a2 <- sample((a+1):100,1)
}
etc etc...
I want to report a final vector being the concatenation of a1,a2,a(n):
result <- c(a1,a2)
Even though this sounds like a homework question, it is not. I thankfully left the days of homework many years ago.
Coming late to the party, but I think this is gonna rock your world:
unique(cummax(sample.int(100)))
This uses a while loop and is wrapped in a function
# from ?sample
resample <- function(x, ...) x[sample.int(length(x), ...)]
sample_z <- function(n){
z <- numeric(n)
new <- 0
count <- 1
while(new < n){
from <- seq(new+1,n,by=1)
new <- resample(from, size= 1)
z[count] <- new
if(new < n) count <- count+1
}
z[1:count]
}
set.seed(1234)
sample_z(100)
## [1] 12 67 88 96 100
Edit
note the change to deal with when the new sample is 100 and the way sample deals with an integer as opposed to a vector for x
Edit 2
Actually reading the help for sample gave the useful resample function. Which avoids the pitfalls when length(x) == 1
Not particularly efficient but:
X <- 0
samps <- c()
while (X < 100) {
if(is.null(samps)) {z <- 1 } else {z <- 1 + samps[length(samps)]}
if (z == 100) {
samps <- c(samps, z)
} else {
samps <- c(samps, sample(z:100, 1))
}
X <- samps[length(samps)]
}
samps
EDIT: Trimming a little fat from it:
samps <- c()
while (is.null(samps[length(samps)]) || samps[length(samps)] < 100 ) {
if(is.null(samps)) {z <- 1 } else {z <- 1 + samps[length(samps)]}
if (z == 100) {
samps <- c(samps, z)
} else {
samps <- c(samps, sample(z:100, 1))
}
}
samps
even later to the party, but just for kicks:
X <- Y <- sample(100L)
while(length(X <- Y) != length(Y <- X[c(TRUE, diff(X)>0)])) {}
> print(X)
[1] 28 44 60 98 100
Sorting Random Vectors
Create a vector of random integers and sort it afterwards.
sort(sample(1:1000, size = 10, replace = FALSE),decreasing = FALSE)
Gives 10 random Integers between 1 and 1000.
> sort(sample(1:1000, size = 10, replace = FALSE),decreasing = FALSE)
[1] 44 88 164 314 617 814 845 917 944 995
This of course also works with random decimals and floats.

Resources