Gambling algorithm - r

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.

Related

Creating a Russian roulette game in 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

Nesting a function in R until a condition is met

I am looking for an efficient way to nest the same function in R until a condition is met. I hope the following example illustrates my problem clearly.
Consider the function
f(x) = x^2 + 1, with x > 1.
Denote
f^{(k)}(x) = f(f(f(...f(x)))),
where the function f is evaluated k times within itself. Let M > 0, with M given.
Is there any efficient routine in R to determine the minimum value of k such that f^{(k)}(2) > M?
Thank you.
Nothing special for that. Just use a loop:
function(x, M) {
k <- 0
repeat {
x <- x^2 + 1
k <- k + 1
if (x > M)
break
}
k
}
Not particularly efficient, but often the overhead of evaluating f will be greater than the overhead of the loop. If that's not the case (and it might not be for this particular f), I'd suggest doing the equivalent thing in C or C++ (perhaps using Rcpp).
This would be the recursive approach:
# 2^2 + 1 == 5
# 5^2 + 1 == 26
# 26^2 + 1 == 677
f <- function(x,M,k=0){
if(x <= M) k <- f(x^2 + 1,M=M,k+1)
return(k)
}
f(2,3) # 1
f(2,10) # 2
f(2,50) # 3
f(2,700) # 4

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

how to create a new vector via loop

a) Create a vector X of length 20, with the kth element in X = 2k, for k=1…20. Print out the values of X.
b) Create a vector Y of length 20, with all elements in Y equal to 0. Print out the values of Y.
c) Using a for loop, reassigns the value of the k-th element in Y, for k = 1…20. When k < 12, the kth element of Y is reassigned as the cosine of k. When the k ≥ 12, the kth element of Y is reassigned as the value of integral sqrt(t)dt from 0 to K.
for the first two questions, it is simple.
> x1 <- seq(1,20,by=2)
> x <- 2 * x1
> x
[1] 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40
> y <- rep(0,20)
> y
[1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
i got stuck on the last one,
t <- function(i) sqrt(i)
for (i in 1:20) {
if (i < 12) {
y[i] <- cos(i)
}
else if (i >= 12) {
y[i] <- integral(t, lower= 0, Upper = 20)
}
}
y // print new y
Any suggestions? thanks.
What may help is that the command to calculate a one-dimensional integral is integrate not integral.
You have successfully completed the first two, so I'll demonstrate a different way of getting those vectors:
x <- 2 * seq_len(20)
y <- double(length = 20)
As for your function, you have the right idea, but you need to clean up your syntax a bit. For example, you may need to double-check your braces (using a set style like Hadley Wickham's will help you prevent syntax errors and make the code more readable), you don't need the "if" in the else, you need to read up on integrate and see what its inputs, and importantly its outputs are (and which of them you need and how to extract it), and lastly, you need to return a value from your function. Hopefully, that's enough to help you work it out on your own. Good Luck!
Update
Slightly different function to demonstrate coding style and some best practices with loops
Given a working answer has been posted, this is what I did when looking at your question. I think it is worth posting, as as I think that it is a good habit to 1) pre-allocate answers 2) prevent confusion about scope by not re-using the input variable name as an output and 3) use the seq_len and seq_along constructions for for loops, per R Inferno(pdf) which is required reading, in my opinion:
tf <- function(y){
z <- double(length = length(y))
for (k in seq_along(y)) {
if (k < 12) {
z[k] <- cos(k)
} else {
z[k] <- integrate(f = sqrt, lower = 0, upper = k)$value
}
}
return(z)
}
Which returns:
> tf(y)
[1] 0.540302306 -0.416146837 -0.989992497 -0.653643621 0.283662185 0.960170287 0.753902254
[8] -0.145500034 -0.911130262 -0.839071529 0.004425698 27.712816032 31.248114562 34.922139530
[15] 38.729837810 42.666671456 46.728535669 50.911693960 55.212726149 59.628486093
To be honest you almost have it ready and it is good that you have showed some code here:
y <- rep(0,20) #y vector from question 2
for ( k in 1:20) { #start the loop
if (k < 12) { #if k less than 12
y[k] <- cos(k) #calculate cosine
} else if( k >= 12) { #else if k greater or equal to 12
y[k] <- integrate( sqrt, lower=0, upper=k)$value #see below for explanation
}
}
print(y) #prints y
> print(y)
[1] 0.540302306 -0.416146837 -0.989992497 -0.653643621 0.283662185 0.960170287 0.753902254 -0.145500034 -0.911130262 -0.839071529 0.004425698
[12] 27.712816032 31.248114562 34.922139530 38.729837810 42.666671456 46.728535669 50.911693960 55.212726149 59.628486093
First of all stats::integrate is the function you need to calculate the integral
integrate( sqrt, lower=0, upper=2)$value
The first argument is a function which in your case is sqrt. sqrt is defined already in R so there is no need to define it yourself explicitly as t <- function(i) sqrt(i)
The other two arguments as you correctly set in your code are lower and upper.
The function integrate( sqrt, lower=0, upper=2) will return:
1.885618 with absolute error < 0.00022
and that is why you need integrate( sqrt, lower=0, upper=2)$value to only extract the value.
Type ?integrate in your console to see the documentation which will help you a lot I think.

Looping through selected values in R

I want to iterate a loop only for some values so I am using this:
present <- c(3,5,7,8)
for(i in present)
{
print(i)
}
which gives me
[1] 3
[1] 5
[1] 7
[1] 8
however I need to jump to the next value within the loop, say I dont want 5 to be printed in above example.
I cannot use next since I want it in nested for like this
present <- c(3,5,7,8)
for(i in present)
{
k <- i
"Jump to next value of present"
while(k < "The next value for i should come here")
{
k <- k + 1
print(k)
}
}
The output would be 3 4 5 6 7 8 but the condition must check value of k if it exceeds next value of i.
Is there anyway to accomplish this?
I'll take help of C to explain further,
for(i=0; i < 10; i++)
{
for(k=i;k <= i+1;k++)
{
printf("%d", k);
}
}
The link contains output of above code
http://codepad.org/relkenY3
It is easy in C since next value is in sequence, but here next value is not known, hence the problem.
What you should do is loop through two vectors:
x <- head(present, -1)
# [1] 3 5 7
y <- tail(present, -1)
# [1] 5 7 8
and the function to do that is mapply (have a look at ?mapply). A close translation of your pseudo-code would be:
invisible(mapply(function(x, y) while(x < y) {x <- x + 1; print(x)}, x, y))
but maybe you'll find this more interesting:
mapply(seq, x + 1, y)
I suspect the answer is to use seq_along and use it as an index into "present", but as others have pointed out your code does not promise to deliver what you expect, even with that simple modification. The K <- K=1 assignment jumps ahead too far to deliver a value of 3 at any point and the termination condition is likewise not clear. It turns into an infinite loop in the form you construct. Work with this;
present <- c(3,5,7,8)
for(i in seq_along(present))
{
k <- i
while(k < length(present) )
{
k <- k + 1
print(present[k])
}
}

Resources