{-# Language QuasiQuotes, TransformListComp, ParallelListComp, ImportQualifiedPost #-}
module Main (main) where
import Advent (format, counts)
import Data.Foldable (toList)
import Data.List (sortOn, sortBy, elemIndex)
import Data.Maybe (fromJust)
import Data.Map (Map)
import Data.Map qualified as Map
main :: IO ()
IO ()
main =
do input <- [format|2023 7 (%s %d%n)*|]
print (winnings strength1 input)
print (winnings strength2 input)
winnings :: Ord a => (String -> a) -> [(String, Int)] -> Int
winnings :: forall a. Ord a => ([Char] -> a) -> [([Char], Int)] -> Int
winnings [Char] -> a
strength [([Char], Int)]
input =
[Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int
bid Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rank | Int
rank <- [Int
1..]
| ([Char]
hand, Int
bid) <- [([Char], Int)]
input, then (a -> a) -> [a] -> [a]
(([Char], Int) -> a) -> [([Char], Int)] -> [([Char], Int)]
forall {a}. (a -> a) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn by [Char] -> a
strength [Char]
hand]
strength1 :: String -> [Int]
strength1 :: [Char] -> [Int]
strength1 [Char]
hand = Map Char Int -> [Int]
toRank ([Char] -> Map Char Int
forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Int
counts [Char]
hand) [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Char -> Int) -> [Char] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
val [Char]
hand
where
val :: Char -> Int
val Char
x = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Char
x Char -> [Char] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Char]
"23456789TJQKA")
strength2 :: String -> [Int]
strength2 :: [Char] -> [Int]
strength2 [Char]
hand = [Int]
rank [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (Char -> Int) -> [Char] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
val [Char]
hand
where
val :: Char -> Int
val Char
x = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Char
x Char -> [Char] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Char]
"J23456789TQKA")
rank :: [Int]
rank =
case (Char -> Int -> Maybe Int)
-> Char -> Map Char Int -> (Maybe Int, Map Char Int)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
Map.updateLookupWithKey (\Char
_ Int
_ -> Maybe Int
forall a. Maybe a
Nothing) Char
'J' ([Char] -> Map Char Int
forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Int
counts [Char]
hand) of
(Maybe Int
Nothing , Map Char Int
sets) -> Map Char Int -> [Int]
toRank Map Char Int
sets
(Just Int
wilds, Map Char Int
sets) -> [Int] -> [Int]
improve (Map Char Int -> [Int]
toRank Map Char Int
sets)
where
improve :: [Int] -> [Int]
improve [] = [Int
wilds]
improve (Int
x : [Int]
xs) = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wilds Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
xs
toRank :: Map Char Int -> [Int]
toRank :: Map Char Int -> [Int]
toRank = (Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Int -> Int -> Ordering) -> Int -> Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) ([Int] -> [Int])
-> (Map Char Int -> [Int]) -> Map Char Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Char Int -> [Int]
forall a. Map Char a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList