## Monday, 7 December 2009

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

## Sunday, 6 December 2009

Following on from here I've made some progress on modelling the game of Klondike Solitaire in Haskell.

The code is really ugly and is definitely not idiomatic Haskell - if you can show me how to improve it then that would be much appreciated - it's the only way I'll learn!

There are several concepts in the game of Solitaire. There are:

• Tableau - A set of seven stacks of cards. Cards can be transferred between each stack as long according to some rules.
• Foundation - The foundation consists of four bases, each representing one suit of cards. The game finishes when all the cards have been placed in order (from Ace to King) onto the foundation.
• Deck - The cards not in the foundation or the tableau are in the deck.

Each item in the tableau has a number of shown cards and some hidden cards.

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

One problem I had was that I wanted to represent a Tableau as being exactly 7 slots. I could do this with a tuple, but then my 7 element tuple would need lots of special functions instead of just using the list functions. There are packages for fixed size lists, but I wanted to try and do something minimal.

Foundations are simpler to model. A foundation consists of four bases.

`  data Base = Base Suit [Card] deriving (Eq,Show)  data Foundation = Foundation Base Base Base Base                    deriving (Show)`

I think I'm missing something - how can I change the definition of Foundation so that each base is represented by a different suit?

Finally, a `Game` consists of all of the elements described above.

`  data Game = Game       {        deck :: [Card]      , foundation :: Foundation      , tableau :: Tableau      } deriving (Show)`

In order to make progress in a `Game`, a series of Move's must be made. The possible moves are enumerated below:

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

Once the basic data structures are in place (even if they can surely be improved), it's simple to sketch out the remaining functions.

`  -- Make a move  move :: Game -> Move -> Game  -- Enumerate all the possible moves from the given game state  getMoves :: Game -> [Move]  -- Play a game using the given playing function and return the list of moves  playGame :: Game -> (Game -> [Move] -> Move) -> [Move]  -- Replay the list of moves  replayMoves :: Game -> [Move] -> Game  replayMoves = foldl move`

My goal will be to write a function that picks the best move from the given choices of type `Game -> [Move] -> Move` and see how many games it solves. If any!

Before I go much further though, I need to spend some time working out how much more of the logic I can force inside the type system. For example, currently `Foundation` allows bases of the same suit; they should be different. Similarly, `Tableau` is just a list of slots. I know that if I just use `map` on this list to transform it, the list stays the same size, but it's not enforced by the type system (for example, I could use `concatMap` and change the size). Can I define that shown cards must always be lists of cards in alternating colours and successive values?

There's some more code on my git hub repository.

## Tuesday, 1 December 2009

Rightly or wrongly, I found myself writing code like this:

`  foo :: [Bar] -> [Baz]  foo xs = if (any f xs) then [] else [Baz 4]`

This can be replaced with a neater list comprehension

`  [Baz 4 | any f xs]`

If the right hand side of the list comprehension evaluation to false, then you get the empty list, else you get the single item in the list.

Neat, though I've no idea whether it's idiomatic Haskell!

As my first attempt at writing a reasonably complex lump of code in Haskell, I thought I'd try and model a card game called Klondike Solitaire. Apparently Solitaire is complex enough that:

... the odds of winning a standard game of non-Thoughtful Klondike are currently unknown. It has been said that the inability for theoreticians to calculate these odds is "one of the embarrassments of applied mathematics

The first step is to try and model the playing cards themselves. Cards have both a Suit and a Value.

`  data Suit = Clubs            | Diamonds            | Hearts            | Spades              deriving (Eq,Enum,Show,Bounded)  data Value = Ace             | Two             | Three             | Four             | Five             | Six             | Seven             | Eight             | Nine             | Ten             | Jack             | Queen             | King             deriving (Eq,Enum,Show,Bounded)  data Card = Card Value Suit              deriving (Eq,Show)`

Suit and Value both derive Eq (for equality), Show (for printing), Enum (for successor and predecessor functions) and Bounded (because they are within bounds). We can now define a complete deck of cards with a simple list comprehension.

`  allCards :: [Card]  allCards = [Card x y | x <- [Ace .. King],  y <- [Clubs .. Spades]]`

Next there are a bunch of helper functions which seem like they'll be generally useful.

`  color :: Card -> Color  color (Card _ s) | s == Clubs || s == Spades = Black                   | otherwise = Red  value :: Card -> Value  value (Card x _) = x  -- |Are the two cards alternate colours?  alternateColors :: Card -> Card -> Bool  alternateColors a b = color a /= color b  -- |Does the second card follow the first?  follows :: Card -> Card -> Bool  follows (Card King _) _ = False  follows (Card v1 _) (Card v2 _) = succ v1 == v2`

`succ` gives the successor of a given function. I don't think I can define Card as an instance of Enum because, depending on the context, the successor could be one of multiple values (e.g. the successor to `Card Ace Spades` might be a `Card Two Spades` or a `Card Two Hearts` depending on the context.

The `-- |` syntax is an indicator for the Haddock documentation tool so that you can associate the comment with the declaration.

Next time, I'll look at defining the types for Klondike Solitaire!