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!