The code is to be used to decide who shall be the first player in the game Wazabi (a popular game developed by Gigamic). So you understand the gist of what I'm trying to do, the following procedure decides who goes first:
Each player rolls a 4, six-sided dice consisting of three outcomes (three faces have 'W', two faces have 'C' and the remaining face has 'G', so there is a 3/6 probability you'd roll a W for example).
The player who rolls the most Ws wins.
In the event of more than one player rolling the highest number of Ws, the players who rolled the highest number re-roll the 4 dice, and then the player with the highest W becomes first (this may happen recursively).
I've designed the below code (albeit messily) in r to try and decide who this player should be, but after a few hours of attempts and a tired brain for company I'm hoping one of you will be able to help me out. Here's the output in R console from my code:
who_first <- function(){
dummylist <- c()
playersdummy <- 1:number_of_players
first_rolling <- function(players_left=number_of_players){
for(i in 1:players_left){
# Random variable where 1, 2 & 3 represents Ws, Cs and Gs respectively.
die_poss <- c(1, 1, 1, 2, 2, 3)
die_result <- sample(die_poss, 4, replace=T)
dummy2 <- 0
for(j in 1:4){
if(die_result[j]==1){
dummy2 <- dummy2 + 1
}
}
dummy3 <- append(dummylist, dummy2, after=i)
# dummylist stores the number of Ws rolled by each respective player,
# i.e. first element says how many Ws 1st player still left in rolled.
dummylist <<- dummy3
}
dummy4 <- 0
for(k in 1:players_left){
if(dummylist[k]==max(dummylist)){
# dummy4 represents the number of players who rolled the highest number of Ws that roll.
dummy4 <<- dummy4 + 1
}
}
return(dummy4)
}
while(dummy4 >= 1){
if(dummy4==1){
playersdummy <<- playersdummy[(which(dummylist==max(dummylist))==TRUE)]
return(playersdummy)
}
else if(dummy4 > 1){
dummy5 <- c()
for(l in 1:length(playersdummy)){
if(any((playersdummy[l]==which(dummylist==max(dummylist)))==TRUE)){
dummy6 <- append(dummy5, playersdummy[l], after=l)
dummy5 <<- dummy6
}
}
# playersdummy becomes the vector containing which players are left in the game, i.e. 2 represents player 2.
playersdummy <<- dummy5
dummylist <<- c()
first_rolling(length(playersdummy))
}
}
}
who_first()
[1] 1 2 3 4 5 6 7
Warning message:
In max(dummylist) : no non-missing arguments to max; returning -Inf*
number_of_players is globally defined in another function simply as the number of players in the game. It is equal to 7 in this test.
Clearly I should return a vector of length 1 with the player number for whichever player rolled the most Ws after however many rolls and rerolls. Also, as I'm quite new to R, I'm not exactly sure as to what the warning message is getting at, if someone could explain that'd be helpful.
Here's a code that apparently follows your algorithm but is much simpler than your attempt.
The idea is simple: Since there's no difference between the C and G outcomes, you can just make them the same, valued 0. Make the W outcome 1, and sum the number of times it's been rolled. Then check if there's a winner, if not, keep only the highest ties and repeat.
It does seem that it would be much simpler to just roll the dice once and, in case of a tie, keep those and roll again. But maybe there's more to it.
who_first <- function(n) {
players <- seq_len(n)
found_winner <- FALSE
die_poss <- c(rep(c(0, 1), each = 3))
while (!found_winner) {
cat("Rolling for players", paste(players, collapse = ", "), "\n")
results <- replicate(length(players), sum(sample(die_poss, 4, replace=T)))
cat("Players rolled", paste(results, collapse = ", "), "points\n")
if (sum(max(results) == results) == 1) {
found_winner <- TRUE
winner <- players[which.max(results)]
cat("Winner is player", winner, "\n")
} else {
players <- players[max(results) == results]
}
}
invisible(winner)
}
Some runs:
> set.seed(10)
> who_first(7)
Rolling for players 1, 2, 3, 4, 5, 6, 7
Players rolled 2, 0, 3, 1, 1, 3, 2 points
Rolling for players 3, 6
Players rolled 2, 2 points
Rolling for players 3, 6
Players rolled 4, 1 points
Winner is player 3
> who_first(7)
Rolling for players 1, 2, 3, 4, 5, 6, 7
Players rolled 0, 2, 1, 1, 0, 3, 1 points
Winner is player 6
> who_first(7)
Rolling for players 1, 2, 3, 4, 5, 6, 7
Players rolled 3, 1, 2, 1, 1, 3, 2 points
Rolling for players 1, 6
Players rolled 0, 3 points
Winner is player 6
Related
I'm trying to simulate a dice game, with the following criteria:
(1) You are allowed to roll a die up to 6 times;
(2) At any time during the game, after observing the outcome of the roll, you may stop the game, and you win the dollar amount shown on that roll. For example, your rolls are 5, 1, 3, 4, and you
decide to stop the game, then you win $4; your rolls are 5, 1, 3, 4, 3, 2, with no decision to stop the game, then you win $2.
The function I have at the moment is
stop_on_6 <- function() {
nrolls <- 0
# set.seed(0)
n <- 1
# generate 1 random integer from uniform distribution on [1,6] with
# equal probability.
while (n <= 6){
roll <- sample(1:6, size = 1, replace = TRUE, prob = rep(1/6, 6))
if (roll == 6) {print('A 6 was rolled')
return (roll)}
n <- n + 1
}
sprintf("You've rolled ", n, " times.")
}
The function I'm aiming for will compute your expected winnings over n game plays, assuming that you stop the game only if you get 6 on your roll.
At the moment, when I call the function, prints either "A 6 was rolled", or "You've rolled 7 times". I'm not sure how to make the function roll up to 6 times, but stop if roll == 6.
First part of the answer, you have either both answer because :
1- 6 happens very often when running a dice 6 times.
2- the while loop will stop when n == 7, so you will always have 7 times.
To fix the second case you can either print n-1 or go with n initialised at 0 and while n < 6.
I used the first one below.
stop_on_6 <- function() {
n <- 1
memory = 0
while (n <= 6 & memory != 6){
roll <- sample(1:6, size = 1, replace = TRUE, prob = rep(1/6, 6))
if (roll == 6){
print('A 6 was rolled')
}
memory = roll
n <- n + 1
}
sprintf("You played %d times and won %d", n-1, memory)
}
stop_on_6()
stop_on_6 <- function(episode) {
reward <- c()
for(i in 1:episode) {
n <- 1
while (n <= 6){
roll <- sample(1:6, size = 1, replace = TRUE, prob = rep(1/6, 6))
reward[i] <- roll
n <- ifelse(roll == 6,7,n+1)
}
}
return(paste0("You played ", episode," episode.Your expected reward is ",mean(reward)))
}
stop_on_6(1000)
gives,
"You played 1000 episode.Your expected reward is 4.944"
This question just nerd-sniped me, so here's a loop to give you the optimal strategy each roll. If you get a 5 in the 2nd roll or later, or a 4 in the 5th roll, you should quit, since you'll likely do worse staying in.
dice <- 1:6
breakeven = 0 # no value of rolls after the sixth one
for(i in 6:2) {
next_roll_EV <- breakeven
values_over_future_EV = dice[dice > next_roll_EV] # stop if you get one of these
settle_chance = length(values_over_future_EV)/6
settle_EV = mean(values_over_future_EV)
keep_going_chance = 1 - settle_chance
breakeven = settle_chance*settle_EV + keep_going_chance*next_roll_EV
stop_rolls = dice[dice > breakeven]
print(paste0("roll ", i, " has EV of ", breakeven,
", so stop in the prior roll if you have any of ", paste(stop_rolls, collapse = ", ")))
}
[1] "roll 6 has EV of 3.5, so stop in the prior roll if you have any of 4, 5, 6"
[1] "roll 5 has EV of 4.25, so stop in the prior roll if you have any of 5, 6"
[1] "roll 4 has EV of 4.66666666666667, so stop in the prior roll if you have any of 5, 6"
[1] "roll 3 has EV of 4.94444444444444, so stop in the prior roll if you have any of 5, 6"
[1] "roll 2 has EV of 5.12962962962963, so stop in the prior roll if you have any of 6"
Can somebody help me understand a CS problem.
The problem is the New York Time Rollercoaster problem.
I have a queue:
queue <- seq(from = 1, to = 5)
1 2 3 4 5
A person can bribe another person who is ahead of them in the queue but by only a maximum of 2 times. Thus a queue sequence might look like:
Ride: 1, 2, 3, 4, 5 # Original queue
Ride: 1, 2, 3, 5, 4 # 5 bribes number 4
Ride: 1, 2, 5, 3, 4 # 5 bribes number 3 and thus runs out of bribes and cannot move further (it does not state in the problem if 3 can "re-bribe" 5 so I assume they cannot).
Ride: 2, 1, 5, 3, 4 # 2 bribes number 1
So given the input c(1, 2, 3, 4, 5) what are the minimum number of swaps it would take to get to the final output which would be c(2, 1, 5, 3, 4).
Python code from here:
def minimumBribes(q):
moves = 0
for pos, val in enumerate(q):
if (val-1) - pos > 2:
return "Too chaotic"
for j in xrange(max(0,val-2), pos):
if q[j] > val:
moves+=1
return moves
I am trying to re-create this in R and understand the solution.
Here's a way I think -
minimumBribes <- function(final_q) {
change <- final_q - seq_along(final_q)
if(any(change > 2)) return("Too chaotic!")
sum(change[change > 0])
}
minimumBribes(q = c(2, 1, 5, 3, 4))
[1] 3
Explanation -
initial_q <- 1:5
final_q <- c(2, 1, 5, 3, 4)
# calculate change in position; +ve is gain and -ve is loss
change <- final_q - initial_q
[1] 1 -1 2 -1 -1
# it is clear that if some gained x posn combined then other(s) lost x posn combined
# i.e. sum of posn gains and losses will always be 0
# therefore, to get min total swaps, simply add either gains or losses
# which in a way implies the most direct path from initial_q to final_q
sum(change[change > 0])
[1] 3
I have a random vector (of numbers 1:5) of length 20. I need to count the number of runs of 1 (i.e. each number that is not followed by the same number), 2 (i.e. 2 consecutive numbers the same), 3 and 4.
I'm trying to write a function that takes x[1] and x[2] and compares them, if they are the same then + 1 to a counting variable. After that, x[1] becomes x[2] and x[2] should become x[3] so it keeps on repeating. How do I make x[2] change to x[3] without assigning it again? Sorry if that doesn't make much sense
This is my first day learning R so please simplify as much as you can so I understand lol..
{
startingnumber <- x[1]
nextnumber <- x[2]
count <- 0
repeat {
if (startingnumber == nextnumber) {
count <- count + 1
startingnumber <- nextnumber
nextnumber <- x[3]
} else {
if (startingnumber != nextnumber) {
break
........
}
}
}
}
As mentioned in the comments, using table() on the rle() lengths is probably the most concise solution
E.g:
x <- c(3, 1, 1, 3, 4, 5, 3, 1, 5, 4, 2, 4, 2, 3, 2, 3, 2, 4, 5, 4)
table(rle(x)$lengths)
# 1 2
# 18 1
# or
v <- c(1, 1, 2, 4, 5, 5, 4, 5, 5, 3, 3, 2, 2, 2, 1, 4, 4, 4, 2, 1)
table(rle(v)$lengths)
# 1 2 3
# 6 4 2
In the first example there's 18 singles and one double (the two 1s near the beginning), for a total of 1*18 + 2*1 = 20 values
In the second example there are 6 singles, 4 doubles, and 2 triples, giving a total of 1*6 + 2*4 + 3*2 = 20 values
But if computational speed is of more importance than concise code, we can do better, as both table() and rle() do computations internally that we don't really need. Instead we can assemble a function that only does the bare minimum.
runlengths <- function(x) {
n <- length(x)
r <- which(x[-1] != x[-n])
rl <- diff(c(0, r, n))
rlu <- sort(unique(rl))
rlt <- tabulate(match(rl, rlu))
names(rlt) <- rlu
as.table(rlt)
}
runlengths(x)
# 1 2
# 18 1
runlengths(v)
# 1 2 3
# 6 4 2
Bonus:
You already know that you can compare individual elements of a vector like this
x[1] == x[2]
x[2] == x[3]
but did you know that you can compare vectors with each other, and that you can select multiple elements from a vector by specifying multiple indices? Together that means we can instead of doing
x[1] == x[2]
x[2] == x[3]
.
.
.
x[18] == x[19]
x[19] == x[20]
do
x[1:19] == x[2:20]
# Or even
x[-length(x)] == x[-1]
As a result of seeing THIS EXAMPLE, I was wondering how I could create one set of 15 shuffled orderings of 1 through 4 in R?
On THIS Website, you can get 1 Set of 15 shuffled Numbers
Ranging: From 1 to 4
As an example, on my run I got:
Set #1:
3, 2, 2, 1, 1, 1, 3, 2, 2, 3, 2, 1, 3, 4, 1
Is there a way I can replicate the above in R?
If I understood correctly your question, at first it comes to mind a solution like the following one: very basic, but it does its job.
size <- 40
vec <- sample(1:4, size = size, replace = TRUE)
while(length(unique(vec)) < 4){
vec <- sample(1:4, size = size, replace = TRUE)
}
vec
The while cycle will not go on for long as it's very unlikely that a digit does not appear in the random vector vec if you sample 40 times.
Of course you can change the size of your vector, the code will still work, except you want vec to be < 4; in that case, the loop will go on indefinitely.
I have the following matrix
m <- matrix(c(2, 4, 3, 5, 1, 5, 7, 9, 3, 7), nrow=5, ncol=2,)
colnames(x) = c("Y","Z")
m <-data.frame(m)
I am trying to create a random number in each row where the upper limit is a number based on a variable value (in this case 1*Y based on each row's value for for Z)
I currently have:
samp<-function(x){
sample(0:1,1,replace = TRUE)}
x$randoms <- apply(m,1,samp)
which work works well applying the sample function independently to each row, but I always get an error when I try to alter the x in sample. I thought I could do something like this:
samp<-function(x){
sample(0:m$Z,1,replace = TRUE)}
x$randoms <- apply(m,1,samp)
but I guess that was wishful thinking.
Ultimately I want the result:
Y Z randoms
2 5 4
4 7 7
3 9 3
5 3 1
1 7 6
Any ideas?
The following will sample from 0 to x$Y for each row, and store the result in randoms:
x$randoms <- sapply(x$Y + 1, sample, 1) - 1
Explanation:
The sapply takes each value in x$Y separately (let's call this y), and calls sample(y + 1, 1) on it.
Note that (e.g.) sample(y+1, 1) will sample 1 random integer from the range 1:(y+1). Since you want a number from 0 to y rather than 1 to y + 1, we subtract 1 at the end.
Also, just pointing out - no need for replace=T here because you are only sampling one value anyway, so it doesn't matter whether it gets replaced or not.
Based on #mathematical.coffee suggestion and my edited example this is the slick final result:
m <- matrix(c(2, 4, 3, 5, 1, 5, 7, 9, 3, 7), nrow=5, ncol=2,)
colnames(m) = c("Y","Z")
m <-data.frame(m)
samp<-function(x){
sample(Z + 1, 1)}
m$randoms <- sapply(m$Z + 1, sample, 1) - 1