Implementing Klondike

A comment on my last post suggested using arrays would be far simpler to model the tableau (and also the foundation). And they were right!

  data Index = A | B | C | D | E | F | G 
             deriving (Eq, Ord, Show, Enum, Ix)

  data Slot = Slot 
      {
        shown :: [Card] 
      , hidden :: [Card] 
      } deriving (Show,Eq)

  type Tableau = Array Index Slot

  type Foundation = Array Suit [Card]

By deriving Index and Suit from the class Ix it becomes possible to use this to index items in an array.

To play Klondike we need to deal the deck out. I've assumed the deck is already shuffled.

  newGame :: [Card] -> Game
  newGame cards = Game d emptyFoundation t where
      (t,d) = dealTableau cards

  emptyFoundation :: Foundation
  emptyFoundation = array (Clubs,Spades) [(s,[]) | s <- [Clubs .. Spades]]

  dealTableau :: [Card] -> (Tableau,[Card])
  dealTableau dk = ((array (A,G) [(A,(Slot [a] as))
                                 ,(B,(Slot [b] bs))
                                 ,(C,(Slot [c] cs))
                                 ,(D,(Slot [d] ds))
                                 ,(E,(Slot [e] es))
                                 ,(F,(Slot [f] fs))
                                 ,(G,(Slot [g] gs))]),
                    rest) where 
      (a:as,h) = splitAt 1 dk
      (b:bs,i) = splitAt 2 h
      (c:cs,j) = splitAt 3 i
      (d:ds,k) = splitAt 4 j
      (e:es,l) = splitAt 5 k
      (f:fs,m) = splitAt 6 l
      (g:gs,rest) = splitAt 7 m

My goal is to write a simple model for Klondike so that I can experiment with various playing strategies. The first stage in this is writing the rules of the games.

  data Move = TurnDeck
            | ToFoundation Index 
            | DeckTo Index
            | DeckUp
            | MoveCards Index Int Index
            | GameOver
              deriving (Show,Eq)

  -- |Can we turn the deck?
  turnDeck :: Game -> Bool
  turnDeck = null . deck

  -- |Is the game complete?
  gameWon :: Game -> Bool
  gameWon game = all empty (elems (tableau game)) && not (turnDeck game)
   
  -- |Does the second card follow the first?
  successor :: Card -> Card -> Bool
  successor a b = value a /= King && alternateColors a b && follows a b

  -- |Can the card move down from the deck to the given slot?
  cardDown :: Card -> Slot -> Bool
  cardDown card (Slot s _) | null s = value card == King
                           | otherwise = successor card (head s)

  -- |Can the card move to foundation?
  cardUp :: Card -> Foundation -> Bool
  cardUp (Card v suit) f | null cards = v == Ace
                         | otherwise = x /=King && succ x == v 
                         where
                           cards = f ! suit
                           (Card x _) = head cards

  -- |Can the card move from x to y?
  slotMove :: Slot -> Slot -> Bool
  slotMove (Slot from _) s | null from = False
                           | otherwise = cardDown (head from) s

Once we have a chunky load of predicates defined, we can put these together to get the list of moves possible from a given game state.

The getMoves function builds up a list of valid moves.

  getMoves :: Game -> [Move]
  getMoves g  = [DeckUp | (not.null) dk && cardUp (head dk) (foundation g)]
                ++ [(DeckTo . fst) x | not.null $ dk, x <- filter (cardDown (head dk) . snd) slots]
                ++ [TurnDeck | not.null $ dk] 
                ++ [ToFoundation is | is <- cardsUp]
                ++ slotMoves 
                ++ [GameOver | gameWon g] where
      dk = deck g
      slots = assocs (tableau g)
      cardsUp = map fst (filter (flip cardUpFromSlot (foundation g) . snd) slots)
      slotMoves = [MoveCards (fst x) 1 (fst y) | x <- slots, y <- slots, 
                                                 fst x /= fst y && slotMove (snd x) (snd y)]

There's also a corresponding move :: Game -> Move -> Game function that performs the given move and returns a new game state. It's a bit chunky to paste here (which probably indicates it could be improved!), but you can grab it from github.

Now that I have a basic model of the game, I just need to write a routine that picks the best move based on the current state. My current thoughts are just to sort the moves according to some criteria (e.g. moving a card up is always preferable to turning the deck), but initial attempts having been that good. Maybe I just need brute force!