在约束下洗牌

Question

我正在研究关于蒙特卡洛斯方法的一本书中的一个问题，但我无法弄清楚。题目如下：

获得随机洗牌：俱乐部 2、3、4、5、6；钻石 2、3、4、5、6；红心 2、3、4、5、6；和黑桃 2、3、4；在这样的没有梅花或黑桃出现在位置 1, 4, 7, . . ., 没有心出现在位置 2, 5, 8, . . ., 并且没有方块或黑桃出现在位置上 3, 6, 9, 。 . . .

我目前最好的解决方案是构建一个可能的卡片矩阵来绘制每行是一个回合，每列是一张卡片，然后迭代这些行。然而，我对问题的维度有疑问，在后来的一些抽奖中，我会运行从可能的卡片中满足问题的限制。

# 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
}

感谢您的帮助！

Answer 1

我建议采用两步法：编写用于从一副牌中抽牌的辅助函数，然后按照您的限制顺序调用这些函数。

在您阅读时请注意：我对牌的命名方式与您的不同（我将两张梅花称为“2C”而不是 1），但一般建议仍然有效。

卡片组的辅助函数

您可以通过创建列表或 data.frame 来代表您正在处理的一副纸牌来处理基于纸牌的问题。

make_deck <- function(){
  list(club = paste0('C', 2:6),
       diamond = paste0('D', 2:6),
       heart = paste0('H', 2:6),
       spade = paste0('S', 2:6))
}

然后，您可以编写函数从一副牌中的特定花色中随机抽取一张牌：

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)
}

一旦您知道自己选择了哪张牌，就可以使用另一个辅助函数将其从牌组中移除：

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)
}

现在，如果我们想从红心套件中抽取一张牌，我们将有以下三个步骤：

deck <- make_deck()
card <- draw_from_suits(deck, 'heart')
deck <- remove_from_deck(deck, card)

有约束的抽样

您确定的这个问题的第二个挑战是您可以运行中途进入死胡同。您可以编写采样函数，使其在每次遇到死胡同时自行重置并从头开始。

您可以通过多种方式做到这一点。一种是使用 while 循环不断尝试直到成功：

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()

您还可以调整 random_w_contraint 函数末尾的 for 循环来执行类似的操作。

在约束下洗牌

Shuffle under constraints

r

math

montecarlo

playing-cards

卡片组的辅助函数

有约束的抽样