AOC 2023 Day 7

day_seven_2023.hs

{-# 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