Done day 17

diff --git a/advent17/Main.hs b/advent17/Main.hs
new file mode 100644 (file)
index 0000000..51dccad
--- /dev/null
+++ b/advent17/Main.hs
@@ -0,0 +1,126 @@
+-- Writeup at https://work.njae.me.uk/2024/12/17/advent-of-code-2024-day-17/
+
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+-- import Control.Applicative
+import qualified Data.IntMap.Strict as M
+import Data.IntMap.Strict ((!))
+import Control.Monad
+import Control.Monad.State.Strict
+import Control.Monad.Reader
+import Control.Monad.Writer
+import Control.Monad.RWS.Strict
+import Data.Bits
+
+type Memory = M.IntMap Int
+
+data Machine = Machine { regA :: Int
+                       , regB :: Int
+                       , regC :: Int
+                       , ip :: Int
+                       }
+  deriving (Show, Eq, Ord)
+
+type MachineHandler = RWS Memory [Int] Machine
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let (machine, program) = successfulParse text
+      print machine
+      print program
+      print $ part1 program machine
+      print $ part2 program machine
+      
+part1 :: Memory -> Machine -> [Int]
+part1 program machine = snd $ runMachine program machine
+
+part2 :: Memory -> Machine -> Int
+part2 program machine = minimum $ foldl' go [0] target 
+  where 
+    target = reverse $ M.elems program
+    go starts t = 
+          do  start <- starts
+              n <- [0..7]
+              let res = snd $ runModified program machine (start * 8 + n)
+              guard (head res == t)
+              return $ start * 8 + n
+
+runModified :: Memory -> Machine -> Int -> (Machine, [Int])
+runModified program machine n = runMachine program (machine { regA = n })
+
+runMachine :: Memory -> Machine -> (Machine, [Int])
+runMachine memory machine = execRWS runAll memory machine
+
+runAll :: MachineHandler ()
+runAll = 
+  do  mem <- ask
+      ip <- gets ip
+      if ip `M.notMember` mem then return () else runStep >> runAll
+
+runStep :: MachineHandler ()
+runStep = 
+    do mem <- ask 
+       i <- gets ip
+       let opcode = mem!i
+       let operand = mem!(i+1)
+       putOutput opcode operand
+       machine <- get
+       let machine' = perform opcode operand i machine
+       put machine'
+       
+putOutput :: Int -> Int -> MachineHandler ()
+putOutput 5 operand = 
+  do  machine <- get
+      let v = comboValue operand machine
+      tell [v `mod` 8]
+putOutput _ _ = return ()
+
+perform :: Int -> Int -> Int -> Machine -> Machine
+perform 0 operand i machine = machine { regA = machine.regA `div` denom , ip=i+2 }
+  where denom = 2 ^ (comboValue operand machine)
+perform 1 operand i machine = machine { regB = machine.regB `xor` operand , ip=i+2 }
+perform 2 operand i machine = machine { regB = b , ip=i+2 }
+  where b = (comboValue operand machine) `mod` 8
+perform 3 operand i machine 
+  | machine.regA == 0 = machine { ip=i+2 }
+  | otherwise = machine { ip = operand }
+perform 4 _ i machine = machine { regB = machine.regB `xor` machine.regC , ip=i+2 }
+perform 5 _ i machine = machine { ip=i+2 }
+perform 6 operand i machine = machine { regB = machine.regA `div` denom , ip=i+2 }
+  where denom = 2 ^ (comboValue operand machine)
+perform 7 operand i machine = machine { regC = machine.regA `div` denom , ip=i+2 }
+  where denom = 2 ^ (comboValue operand machine)
+
+comboValue :: Int -> Machine -> Int
+comboValue 4 machine = regA machine
+comboValue 5 machine = regB machine
+comboValue 6 machine = regC machine
+comboValue n _ = n
+
+-- Parse the input file
+
+fullMachineP :: Parser (Machine, Memory)
+machineP :: Parser Machine
+regP :: Parser Int
+memoryP :: Parser Memory
+
+fullMachineP = (,) <$> machineP <* endOfLine <*> memoryP
+
+machineP = machineify <$> regP <*> regP <*> regP 
+  where machineify a b c = Machine a b c 0
+
+regP = ("Register " *> letter *> ": " *> decimal) <* endOfLine
+
+memoryP = memify <$> ("Program: " *> (decimal `sepBy` ","))
+  where memify = M.fromList . zip [0..]
+ 
+successfulParse :: Text -> (Machine, Memory)
+successfulParse input = 
+  case parseOnly fullMachineP input of
+    Left  _err -> (Machine 0 0 0 0, M.empty) -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right fullMachine -> fullMachine

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index b999e07accd8587014670fc2cd2484616d95ad5f..e89d9c426935c2996180c75396efcdc26bd82f7a 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -167,3 +167,9 @@ executable advent16sa
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent16/MainSearchAlgorithms.hs
   build-depends: containers, linear, search-algorithms
+
+executable advent17
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent17/Main.hs
+  build-depends: containers, text, attoparsec, mtl
+  
\ No newline at end of file