{-# Language QuasiQuotes, ImportQualifiedPost #-}
module Main (main) where
import Advent (format, countBy)
import Control.Monad (foldM)
import Control.Monad.Trans.State (StateT(..))
import Data.Bits ((.&.), (.|.))
import Data.IntMap (IntMap)
import Data.IntMap qualified as IntMap
import Data.List (intersect, foldl')
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromJust)
import Data.Set (Set)
import Data.Set qualified as Set
data Instruction = I !Int !Int !Int !Int deriving Int -> Instruction -> ShowS
[Instruction] -> ShowS
Instruction -> String
(Int -> Instruction -> ShowS)
-> (Instruction -> String)
-> ([Instruction] -> ShowS)
-> Show Instruction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Instruction -> ShowS
showsPrec :: Int -> Instruction -> ShowS
$cshow :: Instruction -> String
show :: Instruction -> String
$cshowList :: [Instruction] -> ShowS
showList :: [Instruction] -> ShowS
Show
data Example = E Registers Instruction Registers deriving Int -> Example -> ShowS
[Example] -> ShowS
Example -> String
(Int -> Example -> ShowS)
-> (Example -> String) -> ([Example] -> ShowS) -> Show Example
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Example -> ShowS
showsPrec :: Int -> Example -> ShowS
$cshow :: Example -> String
show :: Example -> String
$cshowList :: [Example] -> ShowS
showList :: [Example] -> ShowS
Show
type Registers = IntMap Int
main :: IO ()
IO ()
main =
do ([([Int], Int, Int, Int, Int, [Int])]
inp1, [(Int, Int, Int, Int)]
inp2) <- [format|2018 16
(Before: [%u&(, )]%n
%u %u %u %u%n
After: [%u&(, )]%n)&%n
%n%n%n
(%u %u %u %u%n)*|]
let examples :: [Example]
examples = [Registers -> Instruction -> Registers -> Example
E ([Int] -> Registers
toRegisters [Int]
x) (Int -> Int -> Int -> Int -> Instruction
I Int
o Int
a1 Int
a2 Int
a3) ([Int] -> Registers
toRegisters [Int]
y) | ([Int]
x,Int
o,Int
a1,Int
a2,Int
a3,[Int]
y) <- [([Int], Int, Int, Int, Int, [Int])]
inp1]
instructions :: [Instruction]
instructions = [Int -> Int -> Int -> Int -> Instruction
I Int
o Int
a1 Int
a2 Int
a3 | (Int
o,Int
a1,Int
a2,Int
a3) <- [(Int, Int, Int, Int)]
inp2]
Int -> IO ()
forall a. Show a => a -> IO ()
print ([Example] -> Int
part1 [Example]
examples)
Int -> IO ()
forall a. Show a => a -> IO ()
print ([Example] -> [Instruction] -> Int
part2 [Example]
examples [Instruction]
instructions)
toRegisters :: [Int] -> Registers
toRegisters :: [Int] -> Registers
toRegisters = [(Int, Int)] -> Registers
forall a. [(Int, a)] -> IntMap a
IntMap.fromList ([(Int, Int)] -> Registers)
-> ([Int] -> [(Int, Int)]) -> [Int] -> Registers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..]
opcodes :: Map String (Int -> Int -> Int -> Registers -> Registers)
opcodes :: Map String (Int -> Int -> Int -> Registers -> Registers)
opcodes =
let sem :: ((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (Int -> a) -> t -> t -> a
f t
a t
b Int
c IntMap a
regs = (Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
c (a -> IntMap a -> IntMap a) -> a -> IntMap a -> IntMap a
forall a b. (a -> b) -> a -> b
$! (Int -> a) -> t -> t -> a
f (IntMap a
regs IntMap a -> Int -> a
forall a. IntMap a -> Int -> a
IntMap.!) t
a t
b) IntMap a
regs
val :: p -> p
val p
o = p
o in
[(String, Int -> Int -> Int -> Registers -> Registers)]
-> Map String (Int -> Int -> Int -> Registers -> Registers)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (String
"addr", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
reg Int
b)
, (String
"addi", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall {p}. p -> p
val Int
b)
, (String
"mulr", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
reg Int
b)
, (String
"muli", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall {p}. p -> p
val Int
b)
, (String
"banr", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
reg Int
b)
, (String
"bani", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall {p}. p -> p
val Int
b)
, (String
"borr", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
reg Int
b)
, (String
"bori", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> Int -> Int
reg Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int -> Int
forall {p}. p -> p
val Int
b)
, (String
"setr", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
_ -> Int -> Int
reg Int
a)
, (String
"seti", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
_ -> Int -> Int
forall {p}. p -> p
val Int
a)
, (String
"gtir", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> if Int -> Int
forall {p}. p -> p
val Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
reg Int
b then Int
1 else Int
0)
, (String
"gtri", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> if Int -> Int
reg Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall {p}. p -> p
val Int
b then Int
1 else Int
0)
, (String
"gtrr", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> if Int -> Int
reg Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
reg Int
b then Int
1 else Int
0)
, (String
"eqir", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> if Int -> Int
forall {p}. p -> p
val Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
reg Int
b then Int
1 else Int
0)
, (String
"eqri", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> if Int -> Int
reg Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
forall {p}. p -> p
val Int
b then Int
1 else Int
0)
, (String
"eqrr", ((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers
forall {a} {t} {t}.
((Int -> a) -> t -> t -> a)
-> t -> t -> Int -> IntMap a -> IntMap a
sem (((Int -> Int) -> Int -> Int -> Int)
-> Int -> Int -> Int -> Registers -> Registers)
-> ((Int -> Int) -> Int -> Int -> Int)
-> Int
-> Int
-> Int
-> Registers
-> Registers
forall a b. (a -> b) -> a -> b
$ \Int -> Int
reg Int
a Int
b -> if Int -> Int
reg Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
reg Int
b then Int
1 else Int
0)
]
part1 :: [Example] -> Int
part1 :: [Example] -> Int
part1 = (Example -> Bool) -> [Example] -> Int
forall (f :: * -> *) a. Foldable f => (a -> Bool) -> f a -> Int
countBy ((Example -> Bool) -> [Example] -> Int)
-> (Example -> Bool) -> [Example] -> Int
forall a b. (a -> b) -> a -> b
$ \Example
example -> Int
3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Int, [String]) -> [String]
forall a b. (a, b) -> b
snd (Example -> (Int, [String])
getMatches Example
example))
part2 :: [Example] -> [Instruction] -> Int
part2 :: [Example] -> [Instruction] -> Int
part2 [Example]
examples [Instruction]
program = Registers
finalRegs Registers -> Int -> Int
forall a. IntMap a -> Int -> a
IntMap.! Int
0
where
finalRegs :: Registers
finalRegs = (Registers -> Instruction -> Registers)
-> Registers -> [Instruction] -> Registers
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Registers -> Instruction -> Registers
eval ([Int] -> Registers
toRegisters [Int
0,Int
0,Int
0,Int
0]) [Instruction]
program
semantics :: IntMap (Int -> Int -> Int -> Registers -> Registers)
semantics = (Map String (Int -> Int -> Int -> Registers -> Registers)
opcodes Map String (Int -> Int -> Int -> Registers -> Registers)
-> String -> Int -> Int -> Int -> Registers -> Registers
forall k a. Ord k => Map k a -> k -> a
Map.!) (String -> Int -> Int -> Int -> Registers -> Registers)
-> IntMap String
-> IntMap (Int -> Int -> Int -> Registers -> Registers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap [String] -> IntMap String
forall (t :: * -> *) a. (Traversable t, Ord a) => t [a] -> t a
satConstraints ([Example] -> IntMap [String]
getConstraints [Example]
examples)
eval :: Registers -> Instruction -> Registers
eval Registers
regs (I Int
o Int
a Int
b Int
c) = (IntMap (Int -> Int -> Int -> Registers -> Registers)
semantics IntMap (Int -> Int -> Int -> Registers -> Registers)
-> Int -> Int -> Int -> Int -> Registers -> Registers
forall a. IntMap a -> Int -> a
IntMap.! Int
o) Int
a Int
b Int
c Registers
regs
getMatches :: Example -> (Int, [String])
getMatches :: Example -> (Int, [String])
getMatches (E Registers
before (I Int
o Int
a Int
b Int
c) Registers
after) =
(Int
o, [ String
name | (String
name,Int -> Int -> Int -> Registers -> Registers
f) <- Map String (Int -> Int -> Int -> Registers -> Registers)
-> [(String, Int -> Int -> Int -> Registers -> Registers)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String (Int -> Int -> Int -> Registers -> Registers)
opcodes, Registers
after Registers -> Registers -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int -> Int -> Registers -> Registers
f Int
a Int
b Int
c Registers
before ])
getConstraints :: [Example] -> IntMap [String]
getConstraints :: [Example] -> IntMap [String]
getConstraints = ([String] -> [String] -> [String])
-> [(Int, [String])] -> IntMap [String]
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IntMap.fromListWith [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
intersect ([(Int, [String])] -> IntMap [String])
-> ([Example] -> [(Int, [String])]) -> [Example] -> IntMap [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Example -> (Int, [String])) -> [Example] -> [(Int, [String])]
forall a b. (a -> b) -> [a] -> [b]
map Example -> (Int, [String])
getMatches
satConstraints :: (Traversable t, Ord a) => t [a] -> t a
satConstraints :: forall (t :: * -> *) a. (Traversable t, Ord a) => t [a] -> t a
satConstraints t [a]
constraints = (t a, Set a) -> t a
forall a b. (a, b) -> a
fst ([(t a, Set a)] -> (t a, Set a)
forall a. HasCallStack => [a] -> a
head (([a] -> Set a -> [(a, Set a)]) -> t [a] -> Set a -> [(t a, Set a)]
forall (t :: * -> *) (m :: * -> *) a acc b.
(Traversable t, Monad m) =>
(a -> acc -> m (b, acc)) -> t a -> acc -> m (t b, acc)
mapAccumLM [a] -> Set a -> [(a, Set a)]
forall a. Ord a => [a] -> Set a -> [(a, Set a)]
pick t [a]
constraints Set a
forall a. Set a
Set.empty))
where
pick :: Ord a => [a] -> Set a -> [(a, Set a)]
pick :: forall a. Ord a => [a] -> Set a -> [(a, Set a)]
pick [a]
possible Set a
soFar =
[ (a
picked, a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
picked Set a
soFar)
| a
picked <- [a]
possible
, a
picked a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set a
soFar ]
mapAccumLM ::
(Traversable t, Monad m) =>
(a -> acc -> m (b, acc)) -> t a -> acc -> m (t b, acc)
mapAccumLM :: forall (t :: * -> *) (m :: * -> *) a acc b.
(Traversable t, Monad m) =>
(a -> acc -> m (b, acc)) -> t a -> acc -> m (t b, acc)
mapAccumLM a -> acc -> m (b, acc)
f = StateT acc m (t b) -> acc -> m (t b, acc)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT acc m (t b) -> acc -> m (t b, acc))
-> (t a -> StateT acc m (t b)) -> t a -> acc -> m (t b, acc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> StateT acc m b) -> t a -> StateT acc m (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse ((acc -> m (b, acc)) -> StateT acc m b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((acc -> m (b, acc)) -> StateT acc m b)
-> (a -> acc -> m (b, acc)) -> a -> StateT acc m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> acc -> m (b, acc)
f)