约束下的洗牌

时间:2018-10-09 18:05:08

标签: r math montecarlo playing-cards

我正在研究一本有关蒙特卡洛斯方法的书中的问题,无法解决。问题如下:

随机获得随机洗牌:俱乐部 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 3 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
}

感谢您的帮助!

1 个答案:

答案 0 :(得分:0)

我建议采用一种分两个步骤的方法:编写帮助程序以从卡组中抽出卡片,然后以符合您的约束的顺序调用这些函数。

平视时所读的内容:我对卡片的命名方式与您的命名方式不同(我将两人俱乐部称为“ 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)
}

现在,如果要从Hearts套件中抽取一张卡片,我们将执行以下三个步骤:

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循环以执行类似的操作。