Name: Anonymous 2011-04-24 7:00
Well, is it?
data Suit = Clubs|Diamonds|Hearts|Spades
deriving (Bounded, Enum, Eq, Ord, Show) -- Suit ordering for disambiguation, same as in bridge.
data CardRank = Two|Three|Four|Five|Six|Seven|Eight|Nine|Ten|Jack|Queen|King|Ace
deriving (Bounded, Enum, Eq, Ord, Show)
data Card = Card {rank::CardRank, suit::Suit} deriving (Eq,Bounded)
instance Enum Card where
-- Enumeration chosen for practicality; it scales automatically for decks with more or less than thirteen cards per suit.
succ (Card rank suit)
| rank==maxBound = Card minBound (succ suit)
| otherwise = Card (succ rank) suit
pred (Card rank suit)
| rank==minBound = Card maxBound (pred suit)
| otherwise = Card (pred rank) suit
toEnum x = Card (toEnum rank) (toEnum suit) where
(suit,rank)=x`divMod`cardinality
cardinality = (fromEnum (maxBound::CardRank)) + 1
fromEnum (Card rank suit)= fromEnum rank + (fromEnum suit)*cardinality where
cardinality = (fromEnum (maxBound::CardRank)) + 1
instance Show Card where
show (Card rank suit) = show rank ++" of "++ show suit
instance Ord Card where
compare (Card rank0 suit0) (Card rank1 suit1)
| rank0 == rank1 = compare suit0 suit1 --Again, for disambiguation.
| otherwise = compare rank0 rank1
type Hand = [Card] -- A hand should have five cards.
type Deck = [Card] -- A deck can be of arbitrary size.
data Rank =
HighCard Card
|Pair CardRank
|TwoPairs CardRank CardRank --Higher pair first
|ThreeOfAKind CardRank
|Straight CardRank --Highest card
|Flush Card
|FullHouse CardRank CardRank --Three of a kind first, pair second.
|FourOfAKind CardRank
|StraightFlush Card
|RoyalFlush Suit
deriving (Eq, Ord)
instance Show Rank where
show (HighCard (Card rank _)) = show rank++" High"
show (Pair rank)
|rank==Six = "Pair of Sixes" -- check 'em dubz
|otherwise= "Pair of "++show rank++"s"
show (TwoPairs rank0 rank1)
| rank0 == Six = "Sixes and "++show rank1++"s" -- nice, lol
|rank1 == Six = show rank0++"s and Sixes"
|otherwise = show rank0++"s and "++show rank1++"s"
show (ThreeOfAKind rank)
|rank==Six = "Three Sixes"
|otherwise= "Three "++show rank++"s"
show (Straight rank) = "Straight to the "++show rank
show (Flush (Card rank suit))= show rank++"-high Flush of "++show suit
show (FullHouse rank0 rank1)
|rank0==Six = "Sixes full of "++show rank1
|rank1==Six = show rank0 ++"s full of Sixes"
|otherwise = show rank0 ++"s full of "++show rank1++"s"
show (FourOfAKind rank)
|rank==Six = "Quadruple Sixes"
|otherwise = "Quadruple "++show rank++"s"
show (StraightFlush (Card rank suit))
|rank==Five = show suit ++" Steel Wheel"
|otherwise = show suit ++ " Flush Straight to the "++show rank
show (RoyalFlush suit) = "Royal Flush of "++show suit
rankHand::Hand -> [Rank]
rankHand hand@([a@(Card rankA suitA), b@(Card rankB suitB), c@(Card rankC suitC), d@(Card rankD suitD), e@(Card rankE suitE)])
| royalFlush = [RoyalFlush suitA]
| steel && flush = StraightFlush y:(map HighCard singles)
| straight && flush = [StraightFlush z]
| fourAtFirst = (FourOfAKind rankU):[HighCard z]
| fourAtLast = (FourOfAKind rankZ):[HighCard u]
| threeAtFirst && pairAtLast = [FullHouse rankU rankZ]
| threeAtLast && pairAtFirst = [FullHouse rankZ rankU]
| steel = [Flush y]
| flush = [Flush z]
| straight = [Straight rankZ]
| length trips > 0 = ThreeOfAKind (rank $ head trips):(map HighCard $ reverse singles)
| length dubz == 1 = Pair (rank dub):(map HighCard (reverse singles))
| length dubz == 2 = TwoPairs (rank $ head dubs) (rank dub):(map HighCard singles)
| otherwise = map HighCard $ reverse sortedHand where
[u@(Card rankU _),_,_,y,z@(Card rankZ _)] = sortedHand
(dub:dubs) = dubz
sortedHand = sort hand
sortedRanks = map rank sortedHand
groupedByRanks = map (\rank->(length rank, last rank)) $ groupBy (\(Card rank0 _) (Card rank1 _)->rank0==rank1) sortedHand
tri n r = isInfixOf (take n $ repeat r) $ sortedRanks
get n = map (\(_,b)->b) $ filter (\(a,_)->a==n) groupedByRanks
dubz = get 2
trips = get 3
singles = get 1
royalFlush = sortedHand==([Card Ten suitA..Card Ace suitA])
flush = map suit hand == (take 5 $ repeat suitA)
straight = [rankU..rankZ] == sortedRanks
steel = [Two .. Five] ++ [Ace] == sortedRanks
fourAtFirst = tri 4 rankU
fourAtLast = tri 4 rankZ
threeAtFirst = tri 3 rankU
threeAtLast = tri 3 rankZ
pairAtLast = tri 2 rankZ
pairAtFirst = tri 2 rankU
rankHand _ = []