A five card charlie is where you draw five cards and don't go bust, i.e. the points from 5 cards is <= 21. I want to find the probability of a 5 card charlie by brute force - i.e. simulate a large number of "plays" and check if you go bust or not.
by using brute force using R. I'm assuming here that there are 4 decks as is common in Casinos, and I'm sampling 5 cards from these 4 decks, checking if they've won and if so counting it towards the probability. Googling states it should be around 1/50, i.e. 2%:
deck <- c(rep(1:9, 16), rep(10, 64))
n <- 0
size <- 1:10e6
for (i in size){
smpl <- sample(deck,5,replace = F)
if (sum(smpl) <= 21){
n <- n+1
}
}
print(n/max(size) * 100)
[1] 5.98644
Note that "deck" here is the point system, i.e. we have 1:9 points for 4 suits, and 4 deck of cards hence need 1:9 16 times, and similarly Jack Queen King and Ten all count as ten but 4*4*4 possible cards.
Sample 5 cards without replacement, check if the sum is <= 21, and if so count it, then finally do this 10 million times and calculated the probability. However this gives 6% rather than 2%.
I have two questions:
1) How can I modify this so that I can sample 100 million or more plays?
2) Where am I going wrong with the 6% probability?
I think that what is off here is the assumption that it should be 2%.
Your code said about 5%. I've adapted an existing answer and it also says 5%:
deck <- c(rep(1:9, 4), rep(10, 16))
result <- combn(deck, 5, function(x) {sum(x) <= 21})
sum(result)/dim(result)
[1] 0.05385693
For k = 5, 6, 7 - card charlie you could try the following (to compute the probability with simulation) with replicate:
sapply(5:7, function(k) mean(replicate(n=10^6,
sum(sample(c(rep(1:9, 4), rep(10, 16)), k, replace = F)) <= 21)))
#[1] 0.053943 0.008525 0.000890
Here is how the probability decreases with k (for k-card charlie)
library(ggplot2)
ggplot(aes(card, prob),
data=data.frame(card=2:7, prob=sapply(2:7, function(x) mean(replicate(n=10^6, sum(sample(c(rep(1:9, 4), rep(10, 16)),x,replace = F)) <= 21))))) +
geom_point() + geom_line()
Related
recently I am trying to mimic a game.
I am going to throw 2 dice at the same time. If the sum of 2 dice is greater than or equals to 10, I win 1 point.
If it is lower than 10, I lose 1 point. I will do this for 1000 times.
At the very beginning, I draw 2000 random samples with set.seed (1234)
set.seed(1234)
d = sample(c(1:6), size = 2000, replace = T)
d
And then, I turn it into a matrix, and sum each row
a = matrix(d, nrow=1000, ncol=2, byrow=T)
t = rowSums(a)
t
Now, I have 1000 elements (sum of two dice each time). I would like to create a vector X to calculate the point that I can get.
However, how can I apply if statement to create vector X in this time?
Thank you very much
Do you mean this?
X <- ifelse(t>=10,1,-1)
or
X <- 2*(t>=10)-1
Using case_when
library(dplyr)
case_when(t >= 10 ~ 1, TRUE ~ -1)
You could assign a temporary variable and assign points by comparing the values.
tmp <- t
t[tmp >= 10] <- 1
t[tmp < 10] <- -1
Or without a temporary variable.
t1 <- c(-1, 1)[(t >= 10) + 1]
I have a question from a book on Monte Carlos Methods that I am working through and I can not figure it out. The question is as follows:
Obtain random shuffles of the cards: club
2, 3, 4, 5, 6; diamond 2, 3, 4, 5, 6; heart 2, 3, 4, 5, 6; and spade 2, 3, 4; in such
a way that no clubs or spades appear in positions 1, 4, 7, . . ., no hearts
appear in positions 2, 5, 8, . . ., and no diamonds or spades appear in positions
3, 6, 9, . . . .
My current best solution is constructing a matrix of possible cards to draw where each row is a turn and each column a card and to iterate down the rows. However I am having problems with the dimensions of the problem, where by some of the later draws I will run out of possible cards meeting the restraints of the question.
# 1-5 club, 6-10 diamond, 10-15 heart, 16-18 spade
#no spade, club
no_s_c <- matrix(1,nrow = 18, ncol = 18)
no_s_c [,1:5] <- 0
no_s_c[,16:18] <- 0
#no spade no diamond
no_d_s<- matrix(1,nrow = 18, ncol = 18)
no_d_s [,6:10] <- 0
no_d_s[,16:18] <- 0
#no hearts
no_h <- matrix(1,nrow = 18, ncol = 18)
no_h[,10:15] <- 0
turn_no_s_c <- c(1,4,7,10,13,16)
turn_no_d_s <- c(3,6,9,12,15,18)
turn_no_h <- c(2,5,8,11,14,17)
#psudotransition matrix
M <- zeros(18)
for(i in turn_no_s_c){M[i,] <- no_s_c[i,]}
for(i in turn_no_d_s){M[i,] <- no_d_s[i,]}
for(i in turn_no_h){M[i,] <- no_h[i,]}
random_w_contraint <- function(){ # there are problems with the dimension of
this problem
card_order <- rep(0,dim(M)[1])
for(i in 1:dim(M)[1]){
x <- sample(which(M[i,] !=0),1)
card_order[i] <- x
M[,x] <- 0
}
card_order
}
Thanks for your help!
I'd recommend a two-step approach: writing helper functions for drawing cards from a deck, and then calling these functions in an order that meets your constraints.
Heads-up as you read: I'm naming the cards differently than you do (I call the two-of-clubs "2C" instead of 1), but the general advice still stands.
Helper Functions for Card Decks
You can deal with card-based problems by creating a list or data.frame to represent the deck of cards you're working with.
make_deck <- function(){
list(club = paste0('C', 2:6),
diamond = paste0('D', 2:6),
heart = paste0('H', 2:6),
spade = paste0('S', 2:6))
}
Then, you can write functions to draw a random card from particular suits in a deck:
draw_from_suits <- function(deck, suits){
cards <- unlist(deck[suits], use.names = FALSE)
# If there are no cards in the requested suits, return NA
if (length(cards) == 0) { return(NA) }
# Otherwise, grab a random card
sample(cards, 1)
}
Once you know what card you've picked, you can remove it from the deck with another helper function:
get_suit <- function(card){
switch(substr(card, 1, 1),
C = 'club',
D = 'diamond',
H = 'heart',
S = 'spade')
}
remove_from_deck <- function(deck, card){
suit <- get_suit(card)
deck[[suit]] <- setdiff(deck[[suit]], card)
return(deck)
}
Now, if we want to sample a card from the hearts suite, we'd have this three-step process:
deck <- make_deck()
card <- draw_from_suits(deck, 'heart')
deck <- remove_from_deck(deck, card)
Sampling With Constraints
The second challenge in this problem that you identify is that you can run into dead ends partway through. You could write the sampling function so that it resets itself and starts from scratch every time it hits a dead end.
You can do this many ways. One is to use a while loop to keep trying until you succeed:
sample_with_constraint <- function(){
# The suits we're allowed to draw from at each step
suit_sequence <- list(c('heart', 'diamond'),
c('club', 'diamond', 'spade'),
c('heart', 'club'))
# We'll use this variable to track whether we're done dealing cards
dealt <- FALSE
while (dealt == FALSE) {
deck <- make_deck()
hand <- rep(NA, length(unlist(deck)))
# Step through the hand and build it card-by-card
for (ii in seq_along(hand)) {
# Use the modulo operator to identify the step of the sequence
which_suits <- suit_sequence[[(ii %% 3) + 1]]
card <- draw_from_suits(deck, which_suits)
# If we failed to draw a card, this is a dead end
# So break out of this for-loop
if (is.na(card)) { break }
hand[ii] <- card
deck <- remove_from_deck(deck, card)
}
# If there are no more cards in the deck, we've successfully dealt a hand
# In this case, flip 'dealt' to TRUE. Otherwise it stays FALSE and we try again.
dealt <- length(unlist(deck)) == 0
}
return(hand)
}
sample_with_constraint()
You could also adapt the for loop at the end of your random_w_contraint function to do something similar.
UrnA =rep(c(10,5,1),c(5,5,5))
UrnB =rep(c(20,5,1),c(9,3,3))
n=1e3
sum=0
for( i in 1:n ){
dice=sample(1:6,1)
sum=sum+(dice<=4)*sample(UrnA,2,replace = FALSE)+(dice>=5)*sample(UrnB,2,replace = FALSE)
}
E=sum/n
I want to use the sentences above to solve the problem below.
"Urn A contains 5 $10 bills, 5 $5 bills, and 5 $1 bills.
Urn B contains 9 $20 bills, 3 $5 bills, and 3 $1 bills.
A dice is thrown. If it lands on 1,2,3, or 4, two bills are drawn from Urn A (without replacement),
Otherwise two bills are drawn from Urn B. Let X = the total value of the bills drawn.
(a) Use simulations to estimate E[X]."
And the problem is that,when I run the sentence the sum turn out to be a array with two components which really makes me confused.And I calculate it myself and the sum of each components of sum turn out to be the right answer . enter image description here
You can avoid the for loop if you consider that rolling a single die n times is the same as rolling n dice once.
UrnA <- rep(c(10,5,1), c(5,5,5))
UrnB <- rep(c(20,5,1), c(9,3,3))
n <- 1e3
set.seed(2018);
sum(as.integer(sapply(sample(1:6, n, replace = T), function(x)
if (x <= 4) sample(UrnA, 2) else sample(UrnB, 2))))
#[1] 15818
I'm using a fixed seed here for reproducibility; remove if necessary.
We can confirm convergence by repeating the process 1000 times
val <- sapply(1:1000, function(x)
sum(as.integer(sapply(sample(1:6, n, replace = T), function(x)
if (x <= 4) sample(UrnA, 2) else sample(UrnB, 2)))))
ggplot(data.frame(idx = 1:1000, val = val), aes(idx, val)) +
geom_point() +
ylim(0, pretty(max(val))[2])
Both your sample function will return a set of two values. You need to sum their components.
# Instead of
sum=sum+(dice<=4)*sample(UrnA,2,replace = FALSE)+(dice>=5)*sample(UrnB,2,replace = FALSE)
#Use:
sum=sum+sum((dice<=4)*sample(UrnA,2,replace = FALSE)+(dice>=5)*sample(UrnB,2,replace = FALSE))
I have the following problem.
I have multiple subarrays (say 2) that I have populated with character labels (1, 2, 3, 4, 5). My algorithm selects labels at random based on occurrence probabilities.
How can I get R to instead select labels 1:3 for subarray 1 and 4:5 for subarray 2, say, without using subsetting (i.e., []). That is, I want a random subset of labels to be selected for each subarray, instead of all labels assigned to each subarray manually using [].
I know sample() should help.
Using subsetting (which I don't want) one would do
x <- 1:5
sample(x[1:3], size, prob = probs[1:3])
but this assigns labels 1:3 to ALL subarrays.
Would
sample(sample(x), size, replace = TRUE, prob = probs)
work?
Any ideas? Please let me know if this is unclear.
Here is a small example, which selects labels from 1:5 for each of 10 subarrays.
set.seed(1)
N <- 10
K <- 2
Hstar <- 5
probs <- rep(1/Hstar, Hstar)
perms <- 5
## Set up container(s) to hold the identity of each individual from each permutation ##
num.specs <- ceiling(N / K)
## Create an ID for each haplotype ##
haps <- 1:Hstar
## Assign individuals (N) to each subpopulation (K) ##
specs <- 1:num.specs
## Generate permutations, assume each permutation has N individuals, and sample those individuals' haplotypes from the probabilities ##
gen.perms <- function() {
sample(haps, size = num.specs, replace = TRUE, prob = probs) # I would like each subarray to contain a random subset of 1:5.
}
pop <- array(dim = c(perms, num.specs, K))
for (i in 1:K) {
pop[,, i] <- replicate(perms, gen.perms())
}
pop
Hopefully this helps.
I think what you actually want is something like that
num.specs <- 3
haps[sample(seq(haps),size = num.specs,replace = F)]
[1] 3 5 4
That is a random subset of your vector haps ?
Not quite what you want (returns list of matrices instead of 3D array) but this might help
lapply(split(1:5, cut(1:5, breaks=c(0, 2, 5))), function(i) matrix(sample(i, 25, replace=TRUE), ncol=5))
Use cut and split to partition your vector of character labels before sampling them. Here I split your character labels at the value 2. Also, rather than sampling 5 numbers 5 times, you can sample 25 numbers once, and convert to matrix.
I am new in R programming. I need to solve 1 problem in R. I need to simulate the following experiment in R.
A poker hand consists of 5 cards dealt from a conventional pack of 52 cards, the order of the cards not being important. Find the probability that a given hand has at least one king and at least one queen.
I know how to find for atleast 1 king but not for at least one king and at least one queen. for atleast 1 king code is :
deck<- rep(1:13 , each=4)
#here J=11 , Q=12, K=13
nhands <- 1000
Xk<- c(rep(-1, nhands))
for( i in 1:nhands){
hand <- sample( deck , 5 , replace= FALSE)
numberofK<-0
for( j in 1:5){ # count Kings
if( hand[j] == 13){
numberofK <- numberofK +1
}
}
#print(numberofK)
Xk[i] <-numberofK
#print(hand)
}
table(Xk) /nhands
Can anyone please help me in coding the required 1.. Thanks
The probability of a hand of 5 cards that contain at least one king or one queen can be simply written as following, where sample(deck, 5) gives a hand of 5 cards while any(c(12, 13) ...) checks whether King or Queen is within the hand and sum counts how many times such case happens within the 1000 simulation:
set.seed(10)
sum(sapply(1:100000, function(i) { any(c(12, 13) %in% sample(deck, 5))}))/100000
# [1] 0.58365
Theoretically, the probability of such case would be:
(choose(52, 5) - choose(44, 5))/choose(52, 5)
# [1] 0.5821375
Which are pretty close.
And on the other hand, if it is indeed And which means at least a king and a queen, simulation gives:
set.seed(10)
sum(sapply(1:100000, function(i) { all(c(12, 13) %in% sample(deck, 5))}))/100000
# [1] 0.09932
And theoretically:
(choose(52, 5) - choose(44, 5) - (2*(choose(48, 5) - choose(44, 5))))/choose(52, 5)
# [1] 0.1001785
And the number matches closely.