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

Modelling Klondike in Haskell

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

A Haskell Mini-Pattern

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!

Playing Cards with 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!