Перемешать под ограничения

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

Я бы рекомендовал двухэтапный подход: написание вспомогательных функций для вытягивания карт из колоды, а затем вызывать эти функции в порядке, соответствующем вашим ограничениям.

Heads-up, когда вы читаете: IЯ называю карты по-другому, чем вы (я называю два из клубов "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()

Вы также можете адаптировать цикл for в конце вашей функции random_w_contraint, чтобы сделать нечто подобное.