-- In the card game poker, a hand consists of five cards and are ranked, from lowest to highest, in the following way: -- -- High Card: Highest value card. -- One Pair: Two cards of the same value. -- Two Pairs: Two different pairs. -- Three of a Kind: Three cards of the same value. -- Straight: All cards are consecutive values. -- Flush: All cards of the same suit. -- Full House: Three of a kind and a pair. -- Four of a Kind: Four cards of the same value. -- Straight Flush: All cards are consecutive values of same suit. -- Royal Flush: Ten, Jack, Queen, King, Ace, in same suit. -- The cards are valued in the order: -- 2, 3, 4, 5, 6, 7, 8, 9, 10, Jack, Queen, King, Ace. -- -- If two players have the same ranked hands then the rank made up of the highest value wins; for example, a pair of eights beats a pair of fives -- (see example 1 below). But if two ranks tie, for example, both players have a pair of queens, then highest cards in each hand are compared -- (see example 4 below); if the highest cards tie then the next highest cards are compared, and so on. -- -- Consider the following five hands dealt to two players: -- -- Hand Player 1 Player 2 Winner -- 1 5H 5C 6S 7S KD 2C 3S 8S 8D TD Player 2 -- Pair of Fives Pair of Eights -- -- 2 5D 8C 9S JS AC 2C 5C 7D 8S QH Player 1 -- Highest card Ace Highest card Queen -- -- 3 2D 9C AS AH AC 3D 6D 7D TD QD Player 2 -- Three Aces Flush with Diamonds -- -- 4 4D 6S 9H QH QC 3D 6D 7H QD QS Player 1 -- Pair of Queens Pair of Queens -- Highest card Nine Highest card Seven -- -- 5 2H 2D 4C 4D 4S 3C 3D 3S 9S 9D Player 1 -- Full House Full House -- With Three Fours With Three Threes -- -- The file, p054_poker.txt, contains one-thousand random hands dealt to two players. Each line of the file contains ten cards -- (separated by a single space): the first five are Player 1's cards and the last five are Player 2's cards. -- You can assume that all hands are valid (no invalid characters or repeated cards), each player's hand is in no specific order, -- and in each hand there is a clear winner. -- -- How many hands does Player 1 win? import Data.List (sort, sortBy, groupBy, minimumBy, maximumBy) import Data.Function (on) import Data.Maybe (fromJust) data Value = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Eq, Ord, Show, Bounded, Enum) data Suit = Hearts | Diamonds | Clubs | Spades deriving (Eq, Show) data Card = Card { value :: Maybe Value , suit :: Maybe Suit } deriving (Eq, Show) instance Ord Card where (Card v1 _) `compare` (Card v2 _) = v1 `compare` v2 type Hand = [Card] data PokerGame = PokerGame { player1 :: Hand , player2 :: Hand } deriving (Eq, Show) getValue :: Char -> Maybe Value getValue '2' = Just Two getValue '3' = Just Three getValue '4' = Just Four getValue '5' = Just Five getValue '6' = Just Six getValue '7' = Just Seven getValue '8' = Just Eight getValue '9' = Just Nine getValue 'T' = Just Ten getValue 'J' = Just Jack getValue 'Q' = Just Queen getValue 'K' = Just King getValue 'A' = Just Ace getValue _ = Nothing getSuit :: Char -> Maybe Suit getSuit 'H' = Just Hearts getSuit 'D' = Just Diamonds getSuit 'C' = Just Clubs getSuit 'S' = Just Spades getSuit _ = Nothing readCard :: String -> Card readCard (v:s:_) = Card{value=getValue v,suit=getSuit s} readGame :: String -> PokerGame readGame g = PokerGame{player1=map readCard (take 5 (words g)), player2=map readCard (take 5 (reverse (words g)))} royalFlush :: Hand -> Bool royalFlush h = let hs = sort h in length (head (groupBy ((==) `on` suit) hs)) == 5 && [Ten .. Ace] == map (fromJust . value) hs straightFlush :: Hand -> Bool straightFlush h = let hs@(x:_) = sort h start = fromJust . value $ x in length (head (groupBy ((==) `on` suit) hs)) == 5 && take 5 [start..] == map (fromJust . value) hs fourOfAKind :: Hand -> Bool fourOfAKind h = length (maximumBy (compare `on` length) (groupBy ((==) `on` value) (sort h))) == 4 fullHouse :: Hand -> Bool fullHouse h = let hs = sort h in length (minimumBy (compare `on` length) (groupBy ((==) `on` value) hs)) == 2 && length (maximumBy (compare `on` length) (groupBy ((==) `on` value) hs)) == 3 flush :: Hand -> Bool flush h = length (groupBy ((==) `on` suit) h) == 1 straight :: Hand -> Bool straight h = let hs@(x:_) = sort h start = fromJust . value $ x in take 5 [start..] == map (fromJust . value) hs three :: Hand -> Bool three h = length (maximumBy (compare `on` length) (groupBy ((==) `on` value) (sort h))) == 3 twoPairs :: Hand -> Bool twoPairs h = let hs = sort h g_hs = sortBy (flip compare `on` length) (groupBy ((==) `on` value) hs) in length (head g_hs) == 2 && length (head (tail g_hs)) == 2 pair :: Hand -> Bool pair h = length (maximumBy (compare `on` length) (groupBy ((==) `on` value) (sort h))) == 2 findPairVal :: Hand -> Card findPairVal h = head $ concat $ sortBy (flip compare `on` length) (groupBy ((==) `on` value) (sort h)) playGame :: PokerGame -> Int playGame g | royalFlush $ player1 g = 1 | royalFlush $ player2 g = -1 | straightFlush (player1 g) && not (straightFlush (player2 g)) = 1 | straightFlush (player2 g) && not (straightFlush (player1 g)) = -1 | straightFlush (player1 g) && straightFlush (player2 g) = if minimum (player1 g) > minimum (player2 g) then 1 else -1 | fourOfAKind (player1 g) && not (fourOfAKind (player2 g)) = 1 | fourOfAKind (player2 g) && not (fourOfAKind (player1 g)) = -1 | fourOfAKind (player1 g) && fourOfAKind (player2 g) = let (_:x:_) = sort $ player1 g (_:y:_) = sort $ player2 g in if value x > value y then 1 else -1 | fullHouse (player1 g) && not (fullHouse (player2 g)) = 1 | fullHouse (player2 g) && not (fullHouse (player1 g)) = -1 | fullHouse (player1 g) && fullHouse (player2 g) = let (_:_:x:_) = sort $ player1 g (_:_:y:_) = sort $ player2 g in if value x > value y then 1 else -1 | flush (player1 g) && not (flush (player2 g)) = 1 | flush (player2 g) && not (flush (player1 g)) = -1 | flush (player1 g) && flush (player2 g) = if maximum (player1 g) > maximum (player2 g) then 1 else -1 | straight (player1 g) && not (straight (player2 g)) = 1 | straight (player2 g) && not (straight (player1 g)) = -1 | straight (player1 g) && straight (player2 g) = if minimum (player1 g) > minimum (player2 g) then 1 else -1 | three (player1 g) && not (three (player2 g)) = 1 | three (player2 g) && not (three (player1 g)) = -1 | three (player1 g) && three (player2 g) = let (_:_:x:_) = sort $ player1 g (_:_:y:_) = sort $ player2 g in if value x > value y then 1 else -1 | twoPairs (player1 g) && not (twoPairs (player2 g)) = 1 | twoPairs (player2 g) && not (twoPairs (player1 g)) = -1 | twoPairs (player1 g) && twoPairs (player2 g) = let (v:w:x:y:z:_) = sort $ player1 g (a:b:c:d:e:_) = sort $ player2 g in if value y > value d then 1 else if value y < value d then -1 else if value w > value b then 1 else if value w < value b then -1 else if value z > value e then 1 else if value z < value e then -1 else if value x > value c then 1 else if value x < value c then -1 else if value v > value a then 1 else -1 | pair (player1 g) && not (pair (player2 g)) = 1 | pair (player2 g) && not (pair (player1 g)) = -1 | pair (player1 g) && pair (player2 g) = let p1 = findPairVal (player1 g) p2 = findPairVal (player2 g) xs = reverse . sort $ player1 g ys = reverse . sort $ player2 g in if p1 > p2 then 1 else if p2 > p1 then -1 else if xs > ys then 1 else -1 | otherwise = let xs = reverse . sort $ player1 g ys = reverse . sort $ player2 g in if xs > ys then 1 else -1 main = do contents <- readFile "p054_poker.txt" let games = map readGame (lines contents) result = sum $ filter (==1) $ map playGame games putStrLn $ "Project Euler, Problem 54\n" ++ "Answer: " ++ show result