module AOC.Challenge.Day10 (
day10a
, day10b
) where
import AOC.Common (freqs, lookupFreq)
import AOC.Solver ((:~>)(..))
import Data.IntMap (IntMap)
import Data.IntSet (IntSet)
import Text.Read (readMaybe)
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
toChain :: [Int] -> IntSet
toChain :: [Key] -> IntSet
toChain [Key]
xs = IntSet
xsset IntSet -> IntSet -> IntSet
`IS.union` [Key] -> IntSet
IS.fromList [Key
0, Key
top Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
3]
where
xsset :: IntSet
xsset = [Key] -> IntSet
IS.fromList [Key]
xs
top :: Key
top = IntSet -> Key
IS.findMax IntSet
xsset
day10a :: [Int] :~> (Int, Int)
day10a :: [Key] :~> (Key, Key)
day10a = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
{ sParse :: String -> Maybe [Key]
sParse = (String -> Maybe Key) -> [String] -> Maybe [Key]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Maybe Key
forall a. Read a => String -> Maybe a
readMaybe ([String] -> Maybe [Key])
-> (String -> [String]) -> String -> Maybe [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
, sShow :: (Key, Key) -> String
sShow = \(Key
x,Key
y) -> Key -> String
forall a. Show a => a -> String
show (Key
x Key -> Key -> Key
forall a. Num a => a -> a -> a
* Key
y)
, sSolve :: (?dyno::DynoMap) => [Key] -> Maybe (Key, Key)
sSolve = \(IntSet -> [Key]
IS.toList (IntSet -> [Key]) -> ([Key] -> IntSet) -> [Key] -> [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key] -> IntSet
toChain->[Key]
xs) -> (Key, Key) -> Maybe (Key, Key)
forall a. a -> Maybe a
Just
let fs :: Map Key Key
fs = [Key] -> Map Key Key
forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Key
freqs ((Key -> Key -> Key) -> [Key] -> [Key] -> [Key]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (Key -> [Key] -> [Key]
forall a. Key -> [a] -> [a]
drop Key
1 [Key]
xs) [Key]
xs)
in (Key -> Map Key Key -> Key
forall a. Ord a => a -> Map a Key -> Key
lookupFreq Key
1 Map Key Key
fs, Key -> Map Key Key -> Key
forall a. Ord a => a -> Map a Key -> Key
lookupFreq Key
3 Map Key Key
fs)
}
findOrZero :: Num a => Int -> IntMap a -> a
findOrZero :: forall a. Num a => Key -> IntMap a -> a
findOrZero = a -> Key -> IntMap a -> a
forall a. a -> Key -> IntMap a -> a
IM.findWithDefault a
0
pathsToGoal :: Num a => IntSet -> IntMap a
pathsToGoal :: forall a. Num a => IntSet -> IntMap a
pathsToGoal IntSet
is = IntMap a
res
where
res :: IntMap a
res = ((Key -> a) -> IntSet -> IntMap a)
-> IntSet -> (Key -> a) -> IntMap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Key -> a) -> IntSet -> IntMap a
forall a. (Key -> a) -> IntSet -> IntMap a
IM.fromSet IntSet
is ((Key -> a) -> IntMap a) -> (Key -> a) -> IntMap a
forall a b. (a -> b) -> a -> b
$ \Key
i ->
if Key
i Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
goal
then a
1
else [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Key -> IntMap a -> a
forall a. Num a => Key -> IntMap a -> a
findOrZero (Key
i Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
j) IntMap a
res
| Key
j <- [Key
1,Key
2,Key
3]
]
goal :: Key
goal = IntSet -> Key
IS.findMax IntSet
is
day10b :: [Int] :~> Int
day10b :: [Key] :~> Key
day10b = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
{ sParse :: String -> Maybe [Key]
sParse = (String -> Maybe Key) -> [String] -> Maybe [Key]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Maybe Key
forall a. Read a => String -> Maybe a
readMaybe ([String] -> Maybe [Key])
-> (String -> [String]) -> String -> Maybe [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
, sShow :: Key -> String
sShow = Key -> String
forall a. Show a => a -> String
show
, sSolve :: (?dyno::DynoMap) => [Key] -> Maybe Key
sSolve = Key -> Maybe Key
forall a. a -> Maybe a
Just (Key -> Maybe Key) -> ([Key] -> Key) -> [Key] -> Maybe Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> IntMap Key -> Key
forall a. Num a => Key -> IntMap a -> a
findOrZero Key
0 (IntMap Key -> Key) -> ([Key] -> IntMap Key) -> [Key] -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> IntMap Key
forall a. Num a => IntSet -> IntMap a
pathsToGoal (IntSet -> IntMap Key) -> ([Key] -> IntSet) -> [Key] -> IntMap Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key] -> IntSet
toChain
}