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
Ixit 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))]),
(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
| MoveCards Index Int Index
-- |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.
getMovesfunction 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]
++ [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 -> Gamefunction 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!