-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!

Evan Raines
  • 3
  • 1
  • 1

1 Answers1

0

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.

adviksh
  • 123
  • 6