Created
December 7, 2023 14:37
-
-
Save skatenerd/9af592eef85f6fdcc8445d7f8c838b78 to your computer and use it in GitHub Desktop.
AOC 2023 Day 7
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# 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 | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment