Poker hand analyser: Difference between revisions

Content added Content deleted
Line 1,982: Line 1,982:
parseCard :: String -> Maybe Card
parseCard :: String -> Maybe Card
parseCard [] = Nothing
parseCard [] = Nothing
parseCard xs = (\a b -> Card a b) <$> parsedSuit <*> parsedRank
parseCard xs = (\a b -> Card a b) <$> parseSuit <*> parseRank
where parsedRank = case r of "a" -> Just Ace
where parseRank = case r of "a" -> Just Ace
"2" -> Just Two
"2" -> Just Two
"3" -> Just Three
"3" -> Just Three
"4" -> Just Four
"4" -> Just Four
"5" -> Just Five
"5" -> Just Five
"6" -> Just Six
"6" -> Just Six
"7" -> Just Seven
"7" -> Just Seven
"8" -> Just Eight
"8" -> Just Eight
"9" -> Just Nine
"9" -> Just Nine
"10" -> Just Ten
"10" -> Just Ten
"j" -> Just Jack
"j" -> Just Jack
"q" -> Just Queen
"q" -> Just Queen
"k" -> Just King
"k" -> Just King
_ -> Nothing
_ -> Nothing
where r = init xs
where r = init xs
parsedSuit = case s of '♥' -> Just Heart
parseSuit = case s of '♥' -> Just Heart
'♦' -> Just Diamond
'♦' -> Just Diamond
'♣' -> Just Club
'♣' -> Just Club
'♠' -> Just Spade
'♠' -> Just Spade
_ -> Nothing
_ -> Nothing
where s = head $ reverse xs
where s = head $ reverse xs


nameHand :: String -> String
nameHand :: String -> String
nameHand s
nameHand s
| invalidHand = ": invalid"
| invalidHand = ": invalid"
| straight && flush = ": straight-flush"
| straight && flush = ": straight-flush"
| ofKind 4 = ": four-of-a-kind"
| ofKind 4 = ": four-of-a-kind"
| uniqRanks == 2 = ": full-house"
| ofKind 3 && ofKind 2 = " full-house"
| flush = ": flush"
| flush = ": flush"
| straight = ": straight"
| straight = ": straight"
Line 2,019: Line 2,019:
where cards = catMaybes $ map parseCard $ words s
where cards = catMaybes $ map parseCard $ words s
sortedRank = sort $ map rank cards
sortedRank = sort $ map rank cards
sameRank xs = map rankCount groupedByRank
ranks = rankCountTuple cards
where groupedByRank = group sortedRank
where rankCountTuple xs = sortedGroups $ map rankCount $ groupedByRank
rankCount c@(x:xs) = (x, length c)
where groupedByRank = group sortedRank
rankCount c@(x:xs) = (x, length c)
ranks = sameRank cards
sortedGroups = sortBy (\(_, n) (_, n') -> compare n' n)
uniqRanks = length ranks
uniqRanks = length ranks
ofKind n = any (\(_, y) -> n == y) ranks
ofKind n = any (\(_, y) -> n == y) ranks
Line 2,028: Line 2,029:
flush = and $ map (\c -> s == suit c) cards
flush = and $ map (\c -> s == suit c) cards
where s = suit $ head cards
where s = suit $ head cards
invalidHand = length dedup /= 5
invalidHand = length (nub cards) /= 5
where dedup = nub cards


testHands :: [String]
testHands :: [String]
Retrieved from "https://rosettacode.org/wiki/Poker_hand_analyser"