I’ve spent the last couple of days trying to get my head around Haskell beyond the cursory level which my university course demanded. The first project I’m attempting is to write a little poker game, probably not with any AI, but requiring a bunch of different techniques which I need to work on. Tonight, happily, I’ve managed to implement the hand ranking algorithm. It’s not *fully* tested yet but it seems to work.
No licence with this code (use as you like) and no warranty obviously!
I would appreciate any pointers on improving the code if you see fit…
import Control.Monad import Data.List import Listdata Suit = Hearts | Clubs | Spades | Diamonds deriving (Read, Show, Eq, Ord, Enum)data Rank = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Read, Show, Eq, Ord, Enum, Bounded)data Card = Card { rank :: Rank, suit :: Suit } deriving (Eq)instance Ord Card where compare (Card x1 _) (Card x2 _) = compare x1 x2-- Pretty card display print out instance Show Card where show x = show(rank x) ++ " of " ++ show(suit x) data HandType = StraightFlush Rank | FourOfAKind Rank Rank | FullHouse Rank Rank | Flush [Rank] | Straight Rank | ThreeOfAKind Rank [Rank] | TwoPair Rank Rank Rank | Pair Rank [Rank] | HighCard [Rank] deriving (Show)evaluate :: [Card] -> HandType evaluate cards = let sorted = sort cards in case (flush sorted, straight sorted) of (Just f, Just s) -> StraightFlush s (Just f, Nothing) -> Flush f (Nothing, Just s) -> Straight s _ -> case nOfAKind (groupBy (\c d -> rank c == rank d) sorted) of ((3,c):(2,d):[]) -> FullHouse c d ((4,c):(1,d):[]) -> FourOfAKind c d ((3,c): xs) -> ThreeOfAKind c (recombine xs) ((2,c):(2,d):(1,e):[]) -> TwoPair c d e ((2,c): xs) -> Pair c (recombine xs) xs -> HighCard (recombine xs) where recombine xs = snd (unzip xs) nOfAKind [] = [] nOfAKind (x:xs) = (length x, rank (head x)) : (nOfAKind xs) flush (c:cards) = case dropWhile (\x -> suit x == suit c) cards of [] -> Just (map (\x -> rank x) (c:cards)) _ -> Nothing -- N.B must account for 'Wheel' hand straight (x:xs) = if (rank x == Two) && rank (last xs) == Ace then checkNext Two (init xs) else checkNext (rank x) xs checkNext r [] = Just r checkNext r (x:xs) = if (r /= maxBound && (succ r) == (rank x)) then checkNext (rank x) xs else Nothing
1 Comment
