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

module AOC.Challenge.Day13 (
    day13a
  , day13b
  ) where

import           AOC.Common                          (CharParser, parseMaybeLenient)
import           AOC.Solver                          ((:~>)(..))
import           Control.Applicative                 ((<|>))
import           Data.Foldable                       (minimumBy)
import           Data.List                           (foldl')
import           Data.Maybe                          (mapMaybe, catMaybes)
import           Data.Ord                            (comparing)
import qualified Text.Megaparsec                     as P
import qualified Text.Megaparsec.Char                as P
import qualified Text.Megaparsec.Char.Lexer          as PL

parseTrains :: Num a => CharParser [Maybe a]
parseTrains :: forall a. Num a => CharParser [Maybe a]
parseTrains = (Maybe a
forall a. Maybe a
Nothing Maybe a
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity (Maybe a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token String
'x' ParsecT Void String Identity (Maybe a)
-> ParsecT Void String Identity (Maybe a)
-> ParsecT Void String Identity (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> ParsecT Void String Identity a
-> ParsecT Void String Identity (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity a
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
PL.decimal)
    ParsecT Void String Identity (Maybe a)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity [Maybe a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`P.sepBy` Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token String
','

day13a :: (Int, [Int]) :~> (Int, Int)
day13a :: (Int, [Int]) :~> (Int, Int)
day13a = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
    { sParse :: String -> Maybe (Int, [Int])
sParse = Parsec Void String (Int, [Int]) -> String -> Maybe (Int, [Int])
forall s a. Parsec Void s a -> s -> Maybe a
parseMaybeLenient (Parsec Void String (Int, [Int]) -> String -> Maybe (Int, [Int]))
-> Parsec Void String (Int, [Int]) -> String -> Maybe (Int, [Int])
forall a b. (a -> b) -> a -> b
$
        (,) (Int -> [Int] -> (Int, [Int]))
-> ParsecT Void String Identity Int
-> ParsecT Void String Identity ([Int] -> (Int, [Int]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void String Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
PL.decimal ParsecT Void String Identity Int
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.newline)
            ParsecT Void String Identity ([Int] -> (Int, [Int]))
-> ParsecT Void String Identity [Int]
-> Parsec Void String (Int, [Int])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Int] -> [Int])
-> ParsecT Void String Identity [Maybe Int]
-> ParsecT Void String Identity [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity [Maybe Int]
forall a. Num a => CharParser [Maybe a]
parseTrains)
    , sShow :: (Int, Int) -> String
sShow  = \(Int
x,Int
y) -> Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y
    , sSolve :: (?dyno::DynoMap) => (Int, [Int]) -> Maybe (Int, Int)
sSolve = \(Int
t0, [Int]
xs) -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just ((Int, Int) -> Maybe (Int, Int)) -> (Int, Int) -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> (Int, Int)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((Int, Int) -> Int) -> (Int, Int) -> (Int, Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, Int) -> Int
forall a b. (a, b) -> b
snd)
            [ (Int
x, Int
waitTime)
            | Int
x <- [Int]
xs
            , let waitTime :: Int
waitTime = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
t0 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
x)
            ]
    }

day13b :: [(Int, Int)] :~> Int
day13b :: [(Int, Int)] :~> Int
day13b = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
    { sParse :: String -> Maybe [(Int, Int)]
sParse = Parsec Void String [(Int, Int)] -> String -> Maybe [(Int, Int)]
forall s a. Parsec Void s a -> s -> Maybe a
parseMaybeLenient (Parsec Void String [(Int, Int)] -> String -> Maybe [(Int, Int)])
-> Parsec Void String [(Int, Int)] -> String -> Maybe [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ do
        String
_ <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
P.manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
P.anySingle ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.newline
        ((Int, Maybe Int) -> Maybe (Int, Int))
-> [(Int, Maybe Int)] -> [(Int, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int, Maybe Int) -> Maybe (Int, Int)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([(Int, Maybe Int)] -> [(Int, Int)])
-> ([Maybe Int] -> [(Int, Maybe Int)])
-> [Maybe Int]
-> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Maybe Int] -> [(Int, Maybe Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0,Int
1..] ([Maybe Int] -> [(Int, Int)])
-> ParsecT Void String Identity [Maybe Int]
-> Parsec Void String [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void String Identity [Maybe Int]
forall a. Num a => CharParser [Maybe a]
parseTrains
    , sShow :: Int -> String
sShow  = Int -> String
forall a. Show a => a -> String
show
    , sSolve :: (?dyno::DynoMap) => [(Int, Int)] -> Maybe Int
sSolve = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> ([(Int, Int)] -> Int) -> [(Int, Int)] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int)
-> ([(Int, Int)] -> (Int, Int)) -> [(Int, Int)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int) -> (Int, Int) -> (Int, Int))
-> (Int, Int) -> [(Int, Int)] -> (Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int) -> (Int, Int) -> (Int, Int)
forall {b}. Integral b => (b, b) -> (b, b) -> (b, b)
go (Int
0, Int
1)
    }
  where
    go :: (b, b) -> (b, b) -> (b, b)
go (!b
base, !b
step) (b
offset, b
i) = (b
base', b
step b -> b -> b
forall a. Num a => a -> a -> a
* b
i)
      where
        base' :: b
base' = (b -> Bool) -> (b -> b) -> b -> b
forall a. (a -> Bool) -> (a -> a) -> a -> a
until (\b
n -> (b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
offset) b -> b -> b
forall a. Integral a => a -> a -> a
`mod` b
i b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0)
                      (b -> b -> b
forall a. Num a => a -> a -> a
+ b
step)
                      b
base