Number of Dice rolling till reaches a Stop Value - r

I am trying to count the number of dice rolls till it reaches to a definite stop value. For example, I want the stop value as 100. I am writing the following code:
sumofsides <- function(stopvalue) {
totalsum <- 0
while (totalsum < stopvalue) {
face <- sample(6, 1, replace= TRUE)
totalsum <- totalsum + face
}
return(total value)
}
sumofsides(100)
[1] 103
When I am writing the following code to get the number of rolling till it reaches to the stop value. But it's always giving value of 1 which is wrong.
numofrolls <- function(stopvalue) {
totalsum <- 0
while (totalsum < stopvalue) {
face <- sample(6, 1, replace= TRUE)
totalsum <- totalsum + face
}
return(length(face))
}
numofrolls(100)
[1] 1
Any help is appreciated.

In your current loop, you are rewriting totalsum every iteration with a new value, so its length will never go beyond one. One solution would be to use a second variable to count the number of rolls:
rollUntil <- function(n) {
nRolls <- 0
sumRolls <- 0
while (sumRolls <= n) {
sumRolls <- sumRolls + sample.int(6, 1)
nRolls = nRolls + 1
}
return(nRolls)
}
# let's look at the distribution of rolls till 100:
hist(replicate(1000,rollUntil(100)))

Related

Why is my Martingale Simulation Function Failing to Work?

I've just started getting back into coding, and I'm trying to write a few different functions to simulate betting strategies. The first I'm trying to simulate is the martingale strategy, a strategy where you place a roulette bet that has ~ 50% odds (black/red or even/odd) and each time you lose the bet, you double the bet until you won (or pass the max wager).
This is my current function which does not appear to be working. I'm not sure if the logic is sound (too many nested loops become confusing quickly). If anyone could point me in the right direction, that would be awesome.
possible_nums <- floor(runif(5, min=0, max=35)) # generate sequence of random numbers
wager = 5
tot_money <- 10000
wins <- 0
simulations <- 1:500
Martingale <- function(wager, tot_money) {
for(i in simulations) {
while(tot_money >= 5 & wager <= 500 ) { # stop betting if lose by running out of money or surpassing max wager
roll <- sample(possible_nums, 1) # roll number 1-35
if (roll %% 2 == 0) { # we will be betting even/odd (as opposed to black/red) for simulation
wins = wins + 1 # if even, we win
tot_money = tot_money + 5 # add 5 dollars to total money/balance if win
} else {
wager*2 # if roll was odd, double wager
}
}
}
}
print(wins)
print(tot_money)
}
Martingale(5, 1000) # run function
The function isn't even giving me an output when I run it. R seems very picky with the spacing of the brackets. I tried correcting them to not avail. If I get the function working, then I can correct the logic.
Thanks for any help!
You have one closing bracket too much, which closes the function before you print the results:
Martingale <- function(wager, tot_money) {
for(i in simulations) {
while(tot_money >= 5 & wager <= 500 ) { # stop betting if lose by running out of money or surpassing max wager
roll <- sample(possible_nums, 1) # roll number 1-35
if (roll %% 2 == 0) { # we will be betting even/odd (as opposed to black/red) for simulation
wins = wins + 1 # if even, we win
tot_money = tot_money + 5 # add 5 dollars to total money/balance if win
} else {
wager*2 # if roll was odd, double wager
}
}
}
} # <-- this one is too much,
print(wins)
print(tot_money)
}
Also note that your code will NOT terminate: you only increase tot_money, and do not modify the value of wager.
Let me note that you do not simulate a 50% chance: you choose at the beginning 5 random integers below 35 and take samples from those; if you want to simulate an odd/even change, you are better off with rbinom(1, 1, .5).
You might want to swap the way this is simulated and run the simulation-loop outside the Martingale function, and return the values and store them in a array:
Martingale2 <- function(wager, tot_money) {
while(tot_money >= 5 & wager <= 500 ) {
roll <- rbinom(1, 1, .5)
if (roll == 0) {
wins <- wins + 1
tot_money <- tot_money + 5
} else {
tot_money <- tot_money - wager
wager <- wager*2
}
}
list(wins = wins, tot_money = tot_money)
}
simulations <- 500
simulation_results <- t(replicate(simulations, Martingale2(5, 1000)))

Struggling with simulating N rolls for K dice

The function dice takes a parameter n, representing number of rolls for a single six-sided die. It returns a vector of length n that has elements that are integers b/w 1 and 6. I have created the following code for the dice function below. It seems to run properly when I test it.
dice <- function(n) {
x <- c(1:6)
sample(length(x), size = n, replace = TRUE, prob = x)
}
The function kdice takes two parameters, n and k. The parameter n is denoted for number of rolls done. The number of dice rolled is represented by parameter k. The function should return the sum of the k dices, rolled n times. Somehow I have to implement dice() within this function. Below is what I have completed thus far, however the function returns nothing. I have an If and Else statement to make sure that at least 1 dice was rolled at least 1 time. While loop is to make the sum of NumofDice is outputted until it reaches n. Would appreciate any insights, especially how to incorporate the function Dice() in kdice().
kdice <- function(k, n){
NumofDice <- sample(1:6, size = k, replace = TRUE)
RollCount = 0
if(k>0 && n>0) {
while(RollCount < n) {
RollCount = RollCount + 1
sum(NumofDice)
}
}
else {
print("No number of dices were rolled")
}
}
kdice <- function(k, n){
if(k>0 && n>0){
replicate(n, sum(sample(c(1:6),k, replace=TRUE)))
}
else {
print("No number of dices were rolled")
}
}
kdice(4,2)
[1] 15 8
You can try defining kdice using replicate + colSums like below
kdice <- function(k, n) {
tryCatch(
colSums(matrix(replicate(n, dice(k)), nrow = k)),
error = function(e) print("No number of dices were rolled")
)
}
which give result like
> kdice(4, 5)
[1] 17 14 22 13 11
> kdice(4, 0)
[1] "No number of dices were rolled"

R while loop help needed

So I've created a while loop to give a coordinate point, Xm and Ym, which follows a uniform distribution, where the point must be within a circle of radius 25. Below is the code for that:
outcome<-function()
{
done=0
while(done==0){
Xm<-runif(1,-25,25)
Ym<-runif(1,-25,25)
if (Xm^2+Ym^2<=25^2){
z<-c(Xm,Ym)
done=1
}
}
z
}
outcome()
I now need to do the same thing, 250 times. I've changed the code to this:
plotoutcome<-function()
{
done=0
while(done==0){
Xm2<-runif(250,-25,25)
Ym2<-runif(250,-25,25)
if (Xm2^2+Ym2^2<=25^2){
z<-c(Xm2,Ym2)
done=1
}
}
z
}
plotoutcome()
However when I run the second code, I get this error message: In if (Xm2^2 + Ym2^2 <= 25^2) { :
the condition has length > 1 and only the first element will be used.
Any ideas on how to fix this?
The simplest way is to take advantage of outcome:
replicate(250, outcome())
But if a new function is needed, here is a plotoutcome function:
plotoutcome<-function()
{
total <- 0
done <- FALSE
Xtmp <- numeric(250)
Ytmp <- numeric(250)
while(!done){
Xm2 <- runif(1, -25, 25)
Ym2 <- runif(1, -25, 25)
i <- Xm2^2 + Ym2^2 <= 25^2
if(i){
total <- total + 1
Xtmp[total] <- Xm2
Ytmp[total] <- Ym2
}
done <- total == 250
}
list(X = Xtmp, Y = Ytmp)
}
do.call(cbind, plotoutcome())

How to break a repeat loop when its output falls within the 95% confidence interval of the previous 3 outputs?

I have been trying to write a repeat function that breaks whenever its output equilibrates, meaning that it stops after a specific number of iterations, after which the function returns values that fall within the 95% confidence interval of the last 3 values returned by that function. This is example data:
a <- c(1, 5)
a.2 <- c(9, 18)
rbind(a, a.2)
b <- c(1, 0.5)
c <- c(1, 0)
This is the function I am trying out. Every computation of the values is addded to a matrix with two columns. I am using the last three rows to work out a 95% confidence intrval for the two different values. If the values fall within this interval, the function is supposed to break.
repeat {
abc <- sum(a * b) + c
for(alpha in abc[alpha]) {
if (abc[alpha] > 0) {
new.abc[alpha] <- (1-b)a - 0.2(b)
} else {
new.abc[alpha] <- (b-1)a - 0.2(b)
}
}
all.abc <<- matrix(ncol = 2, dimnames = list(c(),c("abc.1", "abc.2")
all.abc <<- rbind(all.abc, new.abc)
s <- apply(all.abc[(length(abc[,1]) - 2):length(abc[,3]),], 2, sd)
n <- apply(all.abc[(length(abc[,1]) - 2):length(abc[,3]),], 2, length)
error <- qnorm(0.975)*s/sqrt(n)
for(j in length(all.abc[j,])) {
for(i in length(all.abc[,i])) {
if((all.abc[j,i] < all.abc[j,i] + error * all.abc[j,i]) &
(all.abc[j,i] > all.abc[j,i] - error * all.abc[j,i])) {
break
}
}
}
}
However, this does not seem to work. I suppose the values of the last rows are not readily available during the execution of the function. I hope I have been clear. Tell me if I need to clarify anything. Thanks!

Track loop iterations

Flip a coin. Success, you win 100, otherwise you lose 50. You will keep playing until you have money in your pocket a. How can the value of a at any iteration be stored?
a <- 100
while (a > 0) {
if (rbinom(1, 1, 0.5) == 1) {
a <- a + 100
} else {
a <- a - 50
}
}
As a final result, when the while loop ends, I would like to be able to look at the value of a for each iteration, instead of just the final result. I consulted the post on Counting the iteration in sapply, but I wasn't able to apply it to this case.
Store the initial value of a in a second vector, and append the new value of a at each iteration.
a <- pocket <- 100
while (a > 0) {
if (rbinom(1, 1, 0.5) == 1) {
a <- a + 100
} else {
a <- a - 50
}
pocket <- c(pocket, a)
}
Of course a vectorised approach may be more efficient, e.g.:
n <- 1000000
x <- c(100, sample(c(100, -50), n, replace=TRUE))
cumsum(x)[1:match(0, cumsum(x))]
But there's no guarantee you'll run out of money within n iterations (in which case you receive an error and can just look at x to see the realised trajectory).
EDIT
In response to concerns voiced by #Roland, the following approach avoids reallocation of memory at each iteration:
n <- 1e6
a <- rep(NA_integer_, n)
a[1] <- 100L # set initial value (integer)
i <- 1 # counter
while(a[i] > 0) {
# first check whether our results will fit. If not, embiggenate `a`.
if(i==length(a)) a <- c(a, rep(NA_integer_, n))
if (rbinom(1, 1, 0.5) == 1) {
a[i+1] <- a[i] + 100L
} else {
a[i+1] <- a[i] - 50L
}
i <- i + 1
}
a[seq_len(i)]

Resources