-- |
-- Module      : AOC.Challenge.Day10
-- License     : BSD3
--
-- Stability   : experimental
-- Portability : non-portable
--
-- Day 10.  See "AOC.Solver" for the types used in this module!
--
-- After completing the challenge, it is recommended to:

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

-- | A map of numbers to the count of how many paths from that number to
-- the goal
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

-- -- it's about 1.5x slower
-- gapMethod :: [Int] -> Int
-- gapMethod xs = sfst
--              . foldl' go (T2 1 0)
--              $ zipWith (-) (tail xs) xs
--   where
--     go (T2 prod run) 1 = T2 prod (run + 1)
--     go (T2 prod run) 3
--       | run > 0   = T2 (prod * trib run) 0
--       | otherwise = T2 prod 0

-- trib :: Int -> Int
-- trib i = tribs !!! (i + 2)
--   where
--     tribs = 0:0:1:zipWith3 (\x y z -> x + y + z) tribs (tail tribs) (tail (tail tribs))

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
    -- , sSolve = Just . gapMethod . IS.toList . toChain
    }