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

247 lines
9.0 KiB
Haskell
Raw Blame History

-- 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.Function (on)
import Data.List (groupBy, maximumBy, minimumBy, sort, sortBy)
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
Reference in New Issue View Git Blame Copy Permalink