-- |
-- Module      : AOC.Challenge.Day15
-- License     : BSD3
--
-- Stability   : experimental
-- Portability : non-portable
--
-- Day 15.  See "AOC.Solver" for the types used in this module!

module AOC.Challenge.Day15 (
    day15a
  , day15b
  ) where

import           AOC.Solver                  ((:~>)(..))
import           Control.Monad.Loops         (whileM_)
import           Control.Monad.ST            (runST)
import           Control.Monad.State.Strict  (evalStateT, get, gets, put)
import           Data.Foldable               (for_)
import           Data.List.Split             (splitOn)
import           GHC.Int                     (Int32)
import           Text.Read                   (readMaybe)
import qualified Data.Vector.Unboxed.Mutable as MV

day15a :: [Int] :~> Int
day15a :: [Int] :~> Int
day15a = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
    { sParse :: String -> Maybe [Int]
sParse = (String -> Maybe Int) -> [String] -> Maybe [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe ([String] -> Maybe [Int])
-> (String -> [String]) -> String -> Maybe [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
","
    , sShow :: Int -> String
sShow  = Int -> String
forall a. Show a => a -> String
show
    , sSolve :: (?dyno::DynoMap) => [Int] -> Maybe Int
sSolve = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> ([Int] -> Int) -> [Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> Int
looper Int
2020
    }

day15b :: [Int] :~> Int
day15b :: [Int] :~> Int
day15b = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
    { sParse :: String -> Maybe [Int]
sParse = ([Int] :~> Int) -> String -> Maybe [Int]
forall a b. (a :~> b) -> String -> Maybe a
sParse [Int] :~> Int
day15a
    , sShow :: Int -> String
sShow  = Int -> String
forall a. Show a => a -> String
show
    , sSolve :: (?dyno::DynoMap) => [Int] -> Maybe Int
sSolve = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> ([Int] -> Int) -> [Int] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> Int
looper Int
30000000
    }

data LoopState = LS
    { LoopState -> Int
lsLastSaid :: !Int
    , LoopState -> Int32
lsCurrTime :: !Int32
    }

looper :: Int -> [Int] -> Int
looper :: Int -> [Int] -> Int
looper Int
n [Int]
xs0 = (forall s. ST s Int) -> Int
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Int) -> Int) -> (forall s. ST s Int) -> Int
forall a b. (a -> b) -> a -> b
$ (StateT LoopState (ST s) Int -> LoopState -> ST s Int)
-> LoopState -> StateT LoopState (ST s) Int -> ST s Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT LoopState (ST s) Int -> LoopState -> ST s Int
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Int -> Int32 -> LoopState
LS Int
0 Int32
0) (StateT LoopState (ST s) Int -> ST s Int)
-> StateT LoopState (ST s) Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ do
    MVector s Int32
v <- Int
-> Int32
-> StateT
     LoopState
     (ST s)
     (MVector (PrimState (StateT LoopState (ST s))) Int32)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
MV.replicate Int
n Int32
0
    [Int]
-> (Int -> StateT LoopState (ST s) ())
-> StateT LoopState (ST s) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int]
xs0 ((Int -> StateT LoopState (ST s) ()) -> StateT LoopState (ST s) ())
-> (Int -> StateT LoopState (ST s) ())
-> StateT LoopState (ST s) ()
forall a b. (a -> b) -> a -> b
$ \Int
y -> do
      LS Int
x Int32
i <- StateT LoopState (ST s) LoopState
forall s (m :: * -> *). MonadState s m => m s
get
      MVector (PrimState (StateT LoopState (ST s))) Int32
-> Int -> Int32 -> StateT LoopState (ST s) ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s Int32
MVector (PrimState (StateT LoopState (ST s))) Int32
v Int
x Int32
i
      LoopState -> StateT LoopState (ST s) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> Int32 -> LoopState
LS Int
y (Int32
i Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1))
    StateT LoopState (ST s) Bool
-> StateT LoopState (ST s) () -> StateT LoopState (ST s) ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m ()
whileM_ ((LoopState -> Bool) -> StateT LoopState (ST s) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
n32) (Int32 -> Bool) -> (LoopState -> Int32) -> LoopState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoopState -> Int32
lsCurrTime)) (StateT LoopState (ST s) () -> StateT LoopState (ST s) ())
-> StateT LoopState (ST s) () -> StateT LoopState (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
      LS Int
x Int32
i <- StateT LoopState (ST s) LoopState
forall s (m :: * -> *). MonadState s m => m s
get
      Int32
lst <- MVector (PrimState (StateT LoopState (ST s))) Int32
-> Int -> StateT LoopState (ST s) Int32
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
MV.unsafeRead MVector s Int32
MVector (PrimState (StateT LoopState (ST s))) Int32
v Int
x
      MVector (PrimState (StateT LoopState (ST s))) Int32
-> Int -> Int32 -> StateT LoopState (ST s) ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MV.unsafeWrite MVector s Int32
MVector (PrimState (StateT LoopState (ST s))) Int32
v Int
x Int32
i
      let j :: Int32
j | Int32
lst Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
==  Int32
0 = Int32
0
            | Bool
otherwise = Int32
i Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
lst
      LoopState -> StateT LoopState (ST s) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int -> Int32 -> LoopState
LS (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
j) (Int32
i Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1))
    (LoopState -> Int) -> StateT LoopState (ST s) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets LoopState -> Int
lsLastSaid
  where
    n32 :: Int32
    n32 :: Int32
n32 = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n