Shuffle under constraints - r
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.
Related
Simulate the probability to get four-of-a-kind (four cards with the same symbol: 7, 8, 9, 10, J, Q, K or A) by drawing 5 cards in R
I tried in this way, but it doesn't work, because I can't match the different cards in the function sum. How can I match the 4 cards?
suits <- c("Clubs", "Diamonds", "Hearts", "Spades")
cards <-c("Ace", 7:10, "Jack", "Queen", "King")
deck2 <- rep(cards, 4)
prob4cards <- function()
{
prob4cards <- sample(deck2, size= 5, replace = FALSE)
sum(prob4cards[,1] == prob4cards[,2] == prob4cards[,3]== prob4cards[,4])
}
The probability of 4 cards being the same out of 5 cards drawn can be found by -
prob4cards <- function(deck) {
prob4cards <- sample(deck, size= 5, replace = FALSE)
any(table(prob4cards) == 4)
}
mean(replicate(10000, prob4cards(deck2)))
Increase the count in replicate to get more accurate results.
Replicating the Monty hall game
I’m trying to replicate the Monty hall game and when I run this function even though I assign the 3 values to results car, host and player, when the player samples the same as the car I get 4 values returned to results. I don’t understand this behavior.
switch <- FALSE
start_game <- function(switch) {
results <- NULL
doors <- c(1, 2, 3)
car <- sample(doors, size = 1, replace = TRUE)
player <- sample(doors, size = 1, replace = FALSE)
host <- doors[-c(player, car)]
results <- c(car, player, host)
results
}
start_game(switch)
Extract an increasing subsequence
I wish to extract an increasing subsequence of a vector, starting from the first element. For example, from this vector: a = c(2, 5, 4, 0, 1, 6, 8, 7) ...I'd like to return: res = c(2, 5, 6, 8). I thought I could use a loop, but I want to avoid it. Another attempt with sort: a = c(2, 5, 4, 0, 1, 6, 8, 7) ind = sort(a, index.return = TRUE)$ix mat = (t(matrix(ind))[rep(1, length(ind)), ] - matrix(ind)[ , rep(1, length(ind))]) mat = ((mat*upper.tri(mat)) > 0) %*% rep(1, length(ind)) == (c(length(ind):1) - 1) a[ind][mat] Basically I sort the input vector and check if the indices verify the condition "no indices at the right hand side are lower" which means that there were no greater values beforehand. But it seems a bit complicated and I wonder if there are easier/quicker solutions, or a pre-built function in R. Thanks
One possibility would be to find the cumulative maxima of the vector, and then extract unique elements: unique(cummax(a)) # [1] 2 5 6 8
The other answer is better, but i made this iterative function which works as well. It works by making all consecutive differences > 0
increasing <- function (input_vec) {
while(!all(diff(input_vec) > 0)){
input_vec <- input_vec[c(1,diff(input_vec))>0]
}
input_vec
}
For loop over selected rows
I am new to R (or any programming language) I want to run a for loop along a selected rows of a Matrix, say 3,5,6,8. I know how to do it for a continuous range. How can I do it?
try this:
my_mat <- matrix(1:20, ncol = 2)
my_seq <- c(3, 5, 6, 8)
for(i in my_seq) {
print(my_mat[i, ])
}
How to skip an error in a loop
I want to skip an error (if there is any) in a loop and continue the next iteration. I want to compute 100 inverse matrices of a 2 by 2 matrix with elements randomly sampled from {0, 1, 2}. It is possible to have a singular matrix (for example,
1 0
2 0
Here is my code
set.seed(1)
count <- 1
inverses <- vector(mode = "list", 100)
repeat {
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
inverses[[count]] <- solve(x)
count <- count + 1
if (count > 100) break
}
At the third iteration, the matrix is singular and the code stops running with an error message. In practice, I would like to bypass this error and continue to the next loop. I know I need to use a try or tryCatch function but I don't know how to use them. Similar questions have been asked here, but they are all really complicated and the answers are far beyond my understanding. If someone can give me a complete code specifically for this question, I really appreciate it.
This would put NULLs into inverses for the singular matrices:
inverses[[count]] <- tryCatch(solve(x), error=function(e) NULL)
If the first expression in a call to tryCatch raises an error, it executes and returns the value of the function supplied to its error argument. The function supplied to the error arg has to take the error itself as an argument (here I call it e), but you don't have to do anything with it.
You could then drop the NULL entries with inverses[! is.null(inverses)].
Alternatively, you could use the lower level try. The choice is really a matter of taste.
count <- 0
repeat {
if (count == 100) break
count <- count + 1
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
x.inv <- try(solve(x), silent=TRUE)
if ('try-error' %in% class(x.inv)) next
else inverses[[count]] <- x.inv
}
If your expression generates an error, try returns an object with class try-error. It will print the message to screen if silent=FALSE. In this case, if x.inv has class try-error, we call next to stop the execution of the current iteration and move to the next one, otherwise we add x.inv to inverses.
Edit:
You could avoid using the repeat loop with replicate and lapply.
matrices <- replicate(100, matrix(sample(0:2, 4, replace=T), 2, 2), simplify=FALSE)
inverses <- lapply(matrices, function(mat) if (det(mat) != 0) solve(mat))
It's interesting to note that the second argument to replicate is treated as an expression, meaning it gets executed afresh for each replicate. This means you can use replicate to make a list of any number of random objects that are generated from the same expression.
Instead of using tryCatch you could simply calculate the determinant of the matrix with the function det. A matrix is singular if and only if the determinant is zero.
Hence, you could test whether the determinant is different from zero and calculate the inverse only if the test is positive:
set.seed(1)
count <- 1
inverses <- vector(mode = "list", 100)
repeat {
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
# if (det(x)) inverses[[count]] <- solve(x)
# a more robust replacement for the above line (see comment):
if (is.finite(determinant(x)$modulus)) inverses[[count]] <- solve(x)
count <- count + 1
if (count > 100) break
}
Update:
It is, however, possible to avoid generating singular matrices. The determinant of a 2-by-2 matrix mat is definded as mat[1] * mat[4] - mat[3] * mat[2]. You could use this knowledge for sampling random numbers. Just do not sample numbers which will produce a singular matrix. This, of course, depends on the numbers sampled before.
set.seed(1)
count <- 1
inverses <- vector(mode = "list", 100)
set <- 0:2 # the set of numbers to sample from
repeat {
# sample the first value
x <- sample(set, 1)
# if the first value is zero, the second and third one are not allowed to be zero.
new_set <- ifelse(x == 0, setdiff(set, 0), set)
# sample the second and third value
x <- c(x, sample(new_set, 2, replace = T))
# calculate which 4th number would result in a singular matrix
not_allowed <- abs(-x[3] * x[2] / x[1])
# remove this number from the set
new_set <- setdiff(0:2, not_allowed)
# sample the fourth value and build the matrix
x <- matrix(c(x, sample(new_set, 1)), 2, 2)
inverses[[count]] <- solve(x)
count <- count + 1
if (count > 100) break
}
This procedure is a guarantee that all generated matrices will have an inverse.
try is just a way of telling R: "If you commit an error inside the following parentheses, then skip it and move on."
So if you're worried that x <- matrix(sample(0:2, 4, replace = T), 2, 2) might give you an error, then all you have to do is:
try(x <- matrix(sample(0:2, 4, replace = T), 2, 2))
However, keep in mind then that x will be undefined if you do this and it ends up not being able to compute the answer. That could cause a problem when you get to solve(x) - so you can either define x before try or just "try" the whole thing:
try(
{
x <- matrix(sample(0:2, 4, replace = T), 2, 2)
inverses[[count]] <- solve(x)
}
)
The documentation for try explains your problem pretty well. I suggest you go through it completely.
Edit: The documentation example looked pretty straightforward and very similar to the op's question. Thanks for the suggestion though. Here goes the answer following the example in the documentation page:
# `idx` is used as a dummy variable here just to illustrate that
# all 100 entries are indeed calculated. You can remove it.
set.seed(1)
mat_inv <- function(idx) {
print(idx)
x <- matrix(sample(0:2, 4, replace = T), nrow = 2)
solve(x)
}
inverses <- lapply(1:100, function(idx) try(mat_inv(idx), TRUE))