advent07/MainWithCase.hs

   1 -- Writeup at https://work.njae.me.uk/2023/12/07/advent-of-code-2023-day-07/
   2
   3 import AoC
   4 import Data.Text (Text)
   5 import qualified Data.Text.IO as TIO
   6 import Data.Attoparsec.Text -- hiding (take)
   7 import Control.Applicative
   8 import Data.List
   9
  10 data Card = Joker | Two | Three | Four | Five | Six | Seven | Eight | Nine |
  11             Ten | Jack | Queen | King | Ace deriving (Eq, Ord, Show)
  12
  13 data HandClass = HighCard | OnePair | TwoPair | ThreeOfAKind | FullHouse |
  14                  FourOfAKind | FiveOfAKind deriving (Eq, Ord, Show)
  15
  16 data Hand = Hand [Card] Int deriving (Eq, Ord, Show)
  17 data ClassifiedHand = CHand HandClass [Card] Int deriving (Eq, Ord, Show)
  18
  19 type SignatureElement = (Int, [Card])
  20 type Signature = [SignatureElement]
  21
  22 main :: IO ()
  23 main =
  24   do  dataFileName <- getDataFileName
  25       text <- TIO.readFile dataFileName
  26       let hands = successfulParse text
  27       print $ part1 hands
  28       print $ part2 hands
  29
  30 part1, part2 :: [Hand] -> Int
  31 part1 hands = sum $ fmap score rankedHands
  32   where sortedHands = sort $ fmap classify hands
  33         rankedHands = zip [1..] sortedHands
  34         score (r, CHand _ _ bid) = r * bid
  35
  36 part2 = part1 . fmap enJoker
  37
  38 enJoker :: Hand -> Hand
  39 enJoker (Hand cards bid) = Hand jCards bid
  40   where jCards = replace Jack Joker cards
  41
  42 replace :: Eq a => a -> a -> [a] -> [a]
  43 replace f t = fmap (\x -> if x == f then t else x)
  44
  45 classify :: Hand -> ClassifiedHand
  46 classify (Hand cards bid) =
  47   case (sign cards) of
  48     ((5, _):_)        -> CHand FiveOfAKind cards bid
  49     ((4, _):_)        -> CHand FourOfAKind cards bid
  50     ((3, _):(2, _):_) -> CHand FullHouse cards bid
  51     ((3, _):_)        -> CHand ThreeOfAKind cards bid
  52     ((2, _):(2, _):_) -> CHand TwoPair cards bid
  53     ((2, _):_)        -> CHand OnePair cards bid
  54     _                 -> CHand HighCard cards bid
  55
  56 sign :: [Card] -> Signature
  57 -- sign = reverse . sort . fmap (\g -> (length g, g)) . group . sort
  58 sign cards = addJokers nonJokerSigned (length jokers, jokers)
  59   where (jokers, nonJokers) = partition (== Joker) cards
  60         nonJokerSigned = reverse $ sort $ fmap (\g -> (length g, g)) $
  61                            group $ sort nonJokers
  62
  63 addJokers :: Signature -> SignatureElement -> Signature
  64 addJokers [] js = [js]
  65 addJokers ((n, cs):xs) (jn, js) = (n + jn, cs ++ js):xs
  66
  67 -- Parse the input file
  68
  69 handsP :: Parser [Hand]
  70 handP :: Parser Hand
  71 cardP :: Parser Card
  72
  73 handsP = handP `sepBy` endOfLine
  74 handP = Hand <$> ((many1 cardP) <* space) <*> decimal
  75
  76 cardP = (Two <$ "2") <|> (Three <$ "3") <|> (Four <$ "4") <|>
  77         (Five <$ "5") <|> (Six <$ "6") <|> (Seven <$ "7") <|>
  78         (Eight <$ "8") <|> (Nine <$ "9") <|> (Ten <$ "T") <|>
  79         (Jack <$ "J") <|> (Queen <$ "Q") <|> (King <$ "K") <|>
  80         (Ace <$ "A")
  81
  82 successfulParse :: Text -> [Hand]
  83 successfulParse input =
  84   case parseOnly handsP input of
  85     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
  86     Right matches -> matches