fuxino/project-euler-solutions
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add Haskell solution for Problem 54

Browse Source
This commit is contained in:
daniele 2024-11-16 14:57:10 +01:00
parent 5608a19230
commit 29faf4b983
Signed by: fuxino
GPG Key ID: 981A2B2A3BBF5514
2 changed files with 1216 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

216
Haskell/p054.hs Normal file
View File

@ -0,0 +1,216 @@
-- 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
import Data.Function
import System.IO
data Value = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace
deriving (Eq, Ord, Show, Read, Bounded, Enum)
data Suit = Hearts | Diamonds | Clubs | Spades deriving (Eq, Show)
data Card = Card { value :: Value
, suit :: 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 -> Value
getValue '2' = Two
getValue '3' = Three
getValue '4' = Four
getValue '5' = Five
getValue '6' = Six
getValue '7' = Seven
getValue '8' = Eight
getValue '9' = Nine
getValue 'T' = Ten
getValue 'J' = Jack
getValue 'Q' = Queen
getValue 'K' = King
getValue 'A' = Ace
getSuit :: Char -> Suit
getSuit 'H' = Hearts
getSuit 'D' = Diamonds
getSuit 'C' = Clubs
getSuit 'S' = Spades
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 value hs
straightFlush :: Hand -> Bool
straightFlush h =
let hs@(x:_) = sort h
start = value x
in length (head (groupBy ((==) `on` suit) hs)) == 5 &&
take 5 [start..] == map 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 = value x
in take 5 [start..] == map 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
withFile "p054_poker.txt" ReadMode (\handle -> do
contents <- hGetContents handle
let games = map readGame (lines contents)
result = sum $ filter (==1) $ map playGame games
putStrLn $ "Project Euler, Problem 54\n"
++ "Answer: " ++ show result)

1000
Haskell/p054_poker.txt Normal file
View File

File diff suppressed because it is too large Load Diff