Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# LANGUAGE OverloadedStrings #-}
- module DaySeven (module DaySeven) where
- import qualified Data.Text as T
- import qualified Data.List as L
- import qualified Text.Read as TR
- import qualified Data.Maybe as M
- import qualified Data.Set as S
- import qualified Control.Monad as CM
- import Data.Range((+=+))
- import qualified Data.Range as R
- import Lib (operateOnFile)
- data Card = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Ord, Show, Eq, Enum)
- scoreCardV2 Jack = 0
- scoreCardV2 Two = 1
- scoreCardV2 Three = 2
- scoreCardV2 Four = 3
- scoreCardV2 Five = 4
- scoreCardV2 Six = 5
- scoreCardV2 Seven = 6
- scoreCardV2 Eight = 7
- scoreCardV2 Nine = 8
- scoreCardV2 Ten = 9
- scoreCardV2 Jack = 10
- scoreCardV2 Queen = 11
- scoreCardV2 King = 12
- scoreCardV2 Ace = 13
- data HandType = HighCard | Pair | TwoPair | ThreeOfAKind | FullHouse | FourOfAKind | FiveOfAKind deriving (Ord, Show, Eq, Enum)
- type ScoreableHand = (HandType, [Card])
- type Bid = (ScoreableHand, Int)
- parseCard 'A' = Ace
- parseCard 'K' = King
- parseCard 'Q' = Queen
- parseCard 'J' = Jack
- parseCard 'T' = Ten
- parseCard '9' = Nine
- parseCard '8' = Eight
- parseCard '7' = Seven
- parseCard '6' = Six
- parseCard '5' = Five
- parseCard '4' = Four
- parseCard '3' = Three
- parseCard '2' = Two
- allCards = enumFrom Two
- extractFiveOfAKind :: [Card] -> M.Maybe HandType
- extractFiveOfAKind hand
- | (length (L.nub hand) == 1) = Just FiveOfAKind
- | otherwise = Nothing
- extractFourOfAKind :: [Card] -> M.Maybe HandType
- extractFourOfAKind hand
- | 4 `elem` (cardCounts hand) = Just FourOfAKind
- | otherwise = Nothing
- extractFullHouse hand
- | nonzeroCardCounts hand == [2,3] = Just FullHouse
- | otherwise = Nothing
- extractThreeOfAKind :: [Card] -> M.Maybe HandType
- extractThreeOfAKind hand
- | 3 `elem` (cardCounts hand) = Just ThreeOfAKind
- | otherwise = Nothing
- extractTwoPair :: [Card] -> M.Maybe HandType
- extractTwoPair hand
- | length (filter (> 1) (cardCounts hand)) > 1 = Just TwoPair
- | otherwise = Nothing
- extractPair :: [Card] -> M.Maybe HandType
- extractPair hand
- | length (filter (> 1) (cardCounts hand)) > 0 = Just Pair
- | otherwise = Nothing
- extractHighCard :: [Card] -> M.Maybe HandType
- extractHighCard hand = Just HighCard
- hasHowMany hand card = length $ filter (== card) hand
- cardCounts hand = map (hasHowMany hand) allCards
- nonzeroCardCounts = L.sort . (filter (> 0)) . cardCounts
- classify hand = maximum $ M.catMaybes $ [extractFiveOfAKind hand, extractFourOfAKind hand, extractFullHouse hand, extractThreeOfAKind hand, extractTwoPair hand, extractPair hand, extractHighCard hand]
- classifyV2 hand = maximum hands
- where hands = map (classify . (replace hand Jack)) replacements
- replacements = allCards L.\\ [Jack]
- allCards = enumFrom Two
- replace :: (Eq t) => [t] -> t -> t -> [t]
- replace [] old new = []
- replace (h:t) old new
- | h == old = new:(replace t old new)
- | otherwise = h:(replace t old new)
- score hand = (classify hand, hand)
- parseBid :: T.Text -> Bid
- parseBid row = ((handType, hand), amount)
- where lhs:(rhs:_) = T.split (== ' ') row
- handType = classify $ hand
- hand = map parseCard $ T.unpack lhs
- amount = TR.read $ T.unpack rhs
- parseBidV2 :: T.Text -> Bid
- parseBidV2 row = ((handType, hand), amount)
- where lhs:(rhs:_) = T.split (== ' ') row
- handType = classifyV2 $ hand
- hand = map parseCard $ T.unpack lhs
- amount = TR.read $ T.unpack rhs
- compareBids (firstHand, _) (secondHand, _) = compare firstHand secondHand
- compareBidsV2 ((firstHandType, firstCards), _) ((secondHandType, secondCards), _) = compare (firstHandType, firstCardsV2) (secondHandType, secondCardsV2)
- where firstCardsV2 = map scoreCardV2 firstCards
- secondCardsV2 = map scoreCardV2 secondCards
- testInput = map T.pack ["32T3K 765",
- "T55J5 684",
- "KK677 28",
- "KTJJT 220",
- "QQQJA 483"]
- partOne rows = sum $ map finalScore withIndex
- where finalScore (idx, ((handType, cards), bid)) = idx * bid
- parsed = map parseBid rows
- withIndex = L.zip (enumFrom 1) $ L.sortBy compareBids parsed
- partTwo rows = sum $ map finalScore withIndex
- where finalScore (idx, ((handType, cards), bid)) = idx * bid
- parsed = map parseBidV2 rows
- withIndex = L.zip (enumFrom 1) $ L.sortBy compareBidsV2 parsed
Advertisement
Add Comment
Please, Sign In to add comment