module AOC.Challenge.Day08 (
day08a
, day08b
) where
import AOC.Common (perturbationsBy, CharParser, parseLines, pDecimal)
import AOC.Solver ((:~>)(..))
import Control.DeepSeq (NFData)
import Control.Lens (_1, Ixed(..), Index, IxValue, (^?))
import Data.IntSet (IntSet)
import Data.Maybe (listToMaybe)
import Data.Vector (Vector)
import GHC.Generics (Generic)
import qualified Data.Functor.Foldable as R
import qualified Data.Functor.Foldable.TH as R
import qualified Data.IntSet as IS
import qualified Data.Vector as V
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
data Instr = NOP | ACC | JMP
deriving ((forall x. Instr -> Rep Instr x)
-> (forall x. Rep Instr x -> Instr) -> Generic Instr
forall x. Rep Instr x -> Instr
forall x. Instr -> Rep Instr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Instr x -> Instr
$cfrom :: forall x. Instr -> Rep Instr x
Generic, Instr -> Instr -> Bool
(Instr -> Instr -> Bool) -> (Instr -> Instr -> Bool) -> Eq Instr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instr -> Instr -> Bool
$c/= :: Instr -> Instr -> Bool
== :: Instr -> Instr -> Bool
$c== :: Instr -> Instr -> Bool
Eq, Eq Instr
Eq Instr
-> (Instr -> Instr -> Ordering)
-> (Instr -> Instr -> Bool)
-> (Instr -> Instr -> Bool)
-> (Instr -> Instr -> Bool)
-> (Instr -> Instr -> Bool)
-> (Instr -> Instr -> Instr)
-> (Instr -> Instr -> Instr)
-> Ord Instr
Instr -> Instr -> Bool
Instr -> Instr -> Ordering
Instr -> Instr -> Instr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Instr -> Instr -> Instr
$cmin :: Instr -> Instr -> Instr
max :: Instr -> Instr -> Instr
$cmax :: Instr -> Instr -> Instr
>= :: Instr -> Instr -> Bool
$c>= :: Instr -> Instr -> Bool
> :: Instr -> Instr -> Bool
$c> :: Instr -> Instr -> Bool
<= :: Instr -> Instr -> Bool
$c<= :: Instr -> Instr -> Bool
< :: Instr -> Instr -> Bool
$c< :: Instr -> Instr -> Bool
compare :: Instr -> Instr -> Ordering
$ccompare :: Instr -> Instr -> Ordering
Ord, Int -> Instr -> ShowS
[Instr] -> ShowS
Instr -> String
(Int -> Instr -> ShowS)
-> (Instr -> String) -> ([Instr] -> ShowS) -> Show Instr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instr] -> ShowS
$cshowList :: [Instr] -> ShowS
show :: Instr -> String
$cshow :: Instr -> String
showsPrec :: Int -> Instr -> ShowS
$cshowsPrec :: Int -> Instr -> ShowS
Show)
instance NFData Instr
type Command = (Instr, Int)
instrParser :: CharParser Instr
instrParser :: CharParser Instr
instrParser = [CharParser Instr] -> CharParser Instr
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
[ Instr
NOP Instr -> ParsecT Void String Identity String -> CharParser Instr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string String
Tokens String
"nop"
, Instr
ACC Instr -> ParsecT Void String Identity String -> CharParser Instr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string String
Tokens String
"acc"
, Instr
JMP Instr -> ParsecT Void String Identity String -> CharParser Instr
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
P.string String
Tokens String
"jmp"
]
commandParser :: CharParser Command
commandParser :: CharParser Command
commandParser = (,) (Instr -> Int -> Command)
-> CharParser Instr
-> ParsecT Void String Identity (Int -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CharParser Instr
instrParser CharParser Instr
-> ParsecT Void String Identity () -> CharParser Instr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void String Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
P.space) ParsecT Void String Identity (Int -> Command)
-> ParsecT Void String Identity Int -> CharParser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void String Identity Int
forall s e a.
(Stream s, Token s ~ Char, Ord e, Num a) =>
Parsec e s a
pDecimal
data EndType = Halt | Loop
deriving ((forall x. EndType -> Rep EndType x)
-> (forall x. Rep EndType x -> EndType) -> Generic EndType
forall x. Rep EndType x -> EndType
forall x. EndType -> Rep EndType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EndType x -> EndType
$cfrom :: forall x. EndType -> Rep EndType x
Generic, EndType -> EndType -> Bool
(EndType -> EndType -> Bool)
-> (EndType -> EndType -> Bool) -> Eq EndType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndType -> EndType -> Bool
$c/= :: EndType -> EndType -> Bool
== :: EndType -> EndType -> Bool
$c== :: EndType -> EndType -> Bool
Eq, Eq EndType
Eq EndType
-> (EndType -> EndType -> Ordering)
-> (EndType -> EndType -> Bool)
-> (EndType -> EndType -> Bool)
-> (EndType -> EndType -> Bool)
-> (EndType -> EndType -> Bool)
-> (EndType -> EndType -> EndType)
-> (EndType -> EndType -> EndType)
-> Ord EndType
EndType -> EndType -> Bool
EndType -> EndType -> Ordering
EndType -> EndType -> EndType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EndType -> EndType -> EndType
$cmin :: EndType -> EndType -> EndType
max :: EndType -> EndType -> EndType
$cmax :: EndType -> EndType -> EndType
>= :: EndType -> EndType -> Bool
$c>= :: EndType -> EndType -> Bool
> :: EndType -> EndType -> Bool
$c> :: EndType -> EndType -> Bool
<= :: EndType -> EndType -> Bool
$c<= :: EndType -> EndType -> Bool
< :: EndType -> EndType -> Bool
$c< :: EndType -> EndType -> Bool
compare :: EndType -> EndType -> Ordering
$ccompare :: EndType -> EndType -> Ordering
Ord, Int -> EndType -> ShowS
[EndType] -> ShowS
EndType -> String
(Int -> EndType -> ShowS)
-> (EndType -> String) -> ([EndType] -> ShowS) -> Show EndType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndType] -> ShowS
$cshowList :: [EndType] -> ShowS
show :: EndType -> String
$cshow :: EndType -> String
showsPrec :: Int -> EndType -> ShowS
$cshowsPrec :: Int -> EndType -> ShowS
Show)
instance NFData EndType
data AccStream = EndAcc EndType | Step AccStream | Acc Int AccStream
R.makeBaseFunctor ''AccStream
vmStreamCoalg
:: (Ixed t, Index t ~ Int, IxValue t ~ (Instr, Int))
=> t
-> (IntSet, Int)
-> AccStreamF (IntSet, Int)
vmStreamCoalg :: forall t.
(Ixed t, Index t ~ Int, IxValue t ~ Command) =>
t -> (IntSet, Int) -> AccStreamF (IntSet, Int)
vmStreamCoalg t
cmds (!IntSet
seen, !Int
i)
| Int
i Int -> IntSet -> Bool
`IS.member` IntSet
seen = EndType -> AccStreamF (IntSet, Int)
forall r. EndType -> AccStreamF r
EndAccF EndType
Loop
| Bool
otherwise = case t
cmds t -> Getting (First Command) t Command -> Maybe Command
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index t -> Traversal' t (IxValue t)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index t
i of
Maybe Command
Nothing -> EndType -> AccStreamF (IntSet, Int)
forall r. EndType -> AccStreamF r
EndAccF EndType
Halt
Just Command
cmd -> case Command
cmd of
(Instr
NOP, Int
_) -> (IntSet, Int) -> AccStreamF (IntSet, Int)
forall r. r -> AccStreamF r
StepF (IntSet
seen', Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
(Instr
ACC, Int
n) -> Int -> (IntSet, Int) -> AccStreamF (IntSet, Int)
forall r. Int -> r -> AccStreamF r
AccF Int
n (IntSet
seen', Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
(Instr
JMP, Int
n) -> (IntSet, Int) -> AccStreamF (IntSet, Int)
forall r. r -> AccStreamF r
StepF (IntSet
seen', Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n)
where
seen' :: IntSet
seen' = Int
i Int -> IntSet -> IntSet
`IS.insert` IntSet
seen
sumStreamAlg
:: AccStreamF (EndType, Int)
-> (EndType, Int)
sumStreamAlg :: AccStreamF (EndType, Int) -> (EndType, Int)
sumStreamAlg = \case
EndAccF EndType
es -> (EndType
es, Int
0)
StepF (EndType, Int)
a -> (EndType, Int)
a
AccF Int
n (EndType
es, !Int
x) -> (EndType
es, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
exhaustVM
:: (Ixed t, Index t ~ Int, IxValue t ~ (Instr, Int))
=> t
-> (EndType, Int)
exhaustVM :: forall t.
(Ixed t, Index t ~ Int, IxValue t ~ Command) =>
t -> (EndType, Int)
exhaustVM t
cmds = (AccStreamF (EndType, Int) -> (EndType, Int))
-> ((IntSet, Int) -> AccStreamF (IntSet, Int))
-> (IntSet, Int)
-> (EndType, Int)
forall (f :: * -> *) b a.
Functor f =>
(f b -> b) -> (a -> f a) -> a -> b
R.hylo AccStreamF (EndType, Int) -> (EndType, Int)
sumStreamAlg (t -> (IntSet, Int) -> AccStreamF (IntSet, Int)
forall t.
(Ixed t, Index t ~ Int, IxValue t ~ Command) =>
t -> (IntSet, Int) -> AccStreamF (IntSet, Int)
vmStreamCoalg t
cmds) (IntSet
IS.empty, Int
0)
day08a :: Vector Command :~> Int
day08a :: Vector Command :~> Int
day08a = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
{ sParse :: String -> Maybe (Vector Command)
sParse = ([Command] -> Vector Command)
-> Maybe [Command] -> Maybe (Vector Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Command] -> Vector Command
forall a. [a] -> Vector a
V.fromList (Maybe [Command] -> Maybe (Vector Command))
-> (String -> Maybe [Command]) -> String -> Maybe (Vector Command)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharParser Command -> String -> Maybe [Command]
forall a. Parsec Void String a -> String -> Maybe [a]
parseLines CharParser Command
commandParser
, sShow :: Int -> String
sShow = Int -> String
forall a. Show a => a -> String
show
, sSolve :: (?dyno::DynoMap) => Vector Command -> Maybe Int
sSolve = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> (Vector Command -> Int) -> Vector Command -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EndType, Int) -> Int
forall a b. (a, b) -> b
snd ((EndType, Int) -> Int)
-> (Vector Command -> (EndType, Int)) -> Vector Command -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Command -> (EndType, Int)
forall t.
(Ixed t, Index t ~ Int, IxValue t ~ Command) =>
t -> (EndType, Int)
exhaustVM
}
day08b :: Vector Command :~> Int
day08b :: Vector Command :~> Int
day08b = MkSol :: forall a b.
(String -> Maybe a)
-> ((?dyno::DynoMap) => a -> Maybe b) -> (b -> String) -> a :~> b
MkSol
{ sParse :: String -> Maybe (Vector Command)
sParse = ([Command] -> Vector Command)
-> Maybe [Command] -> Maybe (Vector Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Command] -> Vector Command
forall a. [a] -> Vector a
V.fromList (Maybe [Command] -> Maybe (Vector Command))
-> (String -> Maybe [Command]) -> String -> Maybe (Vector Command)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharParser Command -> String -> Maybe [Command]
forall a. Parsec Void String a -> String -> Maybe [a]
parseLines CharParser Command
commandParser
, sShow :: Int -> String
sShow = Int -> String
forall a. Show a => a -> String
show
, sSolve :: (?dyno::DynoMap) => Vector Command -> Maybe Int
sSolve = \Vector Command
cmds0 -> [Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [
Int
i
| Vector Command
cmds <- Over
(->)
(Bazaar (->) Instr Instr)
(Vector Command)
(Vector Command)
Instr
Instr
-> (Instr -> [Instr]) -> Vector Command -> [Vector Command]
forall (p :: * -> * -> *) a s t.
Conjoined p =>
Over p (Bazaar p a a) s t a a -> (a -> [a]) -> s -> [t]
perturbationsBy ((Command -> Bazaar (->) Instr Instr Command)
-> Vector Command -> Bazaar (->) Instr Instr (Vector Command)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Command -> Bazaar (->) Instr Instr Command)
-> Vector Command -> Bazaar (->) Instr Instr (Vector Command))
-> ((Instr -> Bazaar (->) Instr Instr Instr)
-> Command -> Bazaar (->) Instr Instr Command)
-> Over
(->)
(Bazaar (->) Instr Instr)
(Vector Command)
(Vector Command)
Instr
Instr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Instr -> Bazaar (->) Instr Instr Instr)
-> Command -> Bazaar (->) Instr Instr Command
forall s t a b. Field1 s t a b => Lens s t a b
_1) Instr -> [Instr]
perturbs Vector Command
cmds0
, let (EndType
es, Int
i) = Vector Command -> (EndType, Int)
forall t.
(Ixed t, Index t ~ Int, IxValue t ~ Command) =>
t -> (EndType, Int)
exhaustVM Vector Command
cmds
, EndType
es EndType -> EndType -> Bool
forall a. Eq a => a -> a -> Bool
== EndType
Halt
]
}
where
perturbs :: Instr -> [Instr]
perturbs = \case
Instr
NOP -> [Instr
JMP]
Instr
ACC -> []
Instr
JMP -> [Instr
NOP]