From 21bb9e96af315c2b0953b365df22cc04161c6c41 Mon Sep 17 00:00:00 2001 From: Siphalor Date: Tue, 17 Dec 2024 22:49:59 +0100 Subject: [PATCH] Day seventeen part two --- day-17-haskell/src/Lib.hs | 71 +++++++++++++++++++++++++++++++-------- 1 file changed, 57 insertions(+), 14 deletions(-) diff --git a/day-17-haskell/src/Lib.hs b/day-17-haskell/src/Lib.hs index ece81e8..cefe35f 100644 --- a/day-17-haskell/src/Lib.hs +++ b/day-17-haskell/src/Lib.hs @@ -3,13 +3,14 @@ module Lib where import Control.Monad (join) -import Data.Bits (xor) +import Data.Bits (xor, finiteBitSize, shiftL, countLeadingZeros) import Data.Char (isNumber) +import Data.Int (Int64) import qualified Data.Map.Strict as Map import Flow import Text.ParserCombinators.ReadP -type IntType = Int +type IntType = Int64 type Registers = Map.Map Char IntType data DebuggerInfo = DebuggerInfo { dRegs :: Registers, dInstructions :: [IntType] } @@ -17,16 +18,58 @@ data DebuggerInfo = DebuggerInfo { dRegs :: Registers, dInstructions :: [IntType task1 :: String -> IO IntType task1 input = let di = readInput input + outs = tick 0 (dRegs di) di in do - outs <- tick 0 (dRegs di) di print outs outs |> map show |> join |> read |> return -tick :: IntType -> Registers -> DebuggerInfo -> IO [IntType] -tick pos regs di@DebuggerInfo { dInstructions } = do - print regs +data BruteResult = Negative | Positive IntType Int | Finished IntType Int + deriving (Eq) + +task2 :: String -> IO IntType +task2 input = + let di = readInput input + initial = (dInstructions di) |> map show |> join |> read :: IntType + in do + --putStrLn $ "Starting with " ++ (show initial) + reverseLockingBrute 0 0 di |> expectJust "Failed" |> return + where + simpleBrute :: DebuggerInfo -> IntType + simpleBrute di = + [0..] |> map (\a -> (a, tick 0 (Map.insert 'A' a $ dRegs di) di)) + |> dropWhile (\(_,r) -> (zip r (dInstructions di) |> any (\(a,b) -> a/=b)) || length r /= length (dInstructions di)) + |> head + |> \(a,_) -> a + + reverseLockingBrute :: IntType -> Int -> DebuggerInfo -> Maybe IntType + reverseLockingBrute soFar numsSoFar di = + let tests = [1..8] |> map (\bits -> [0..(2^bits - 1)] |> map (\n -> (bits, n))) |> join :: [(Int, IntType)] + in tryIt tests + + where + tryIt :: [(Int, IntType)] -> Maybe IntType + tryIt [] = Nothing + tryIt (i:rest) = case isWorking i of + Negative -> tryIt rest + Positive n nums -> case reverseLockingBrute n nums di of + Just result -> Just result + Nothing -> tryIt rest + Finished n nums -> Just n + + isWorking :: (Int, IntType) -> BruteResult + isWorking (bits, n) = + let test = shiftL soFar bits + n + result = tick 0 (Map.insert 'A' test $ dRegs di) di + in case (result |> zip (dInstructions di |> reverse |> take (length result) |> reverse) |> all (\(a, b) -> a == b)) && length result > numsSoFar of + False -> Negative + True -> if length result == length (dInstructions di) + then Finished test (length result) + else Positive test (length result) + +tick :: Int -> Registers -> DebuggerInfo -> [IntType] +tick pos regs di@DebuggerInfo { dInstructions } = case drop pos dInstructions of - [] -> return [] + [] -> [] (0:operand:_) -> let result = (regs Map.! 'A') `div` (2 ^ comboValue operand) in tick (pos+2) (Map.insert 'A' result regs) di @@ -39,13 +82,11 @@ tick pos regs di@DebuggerInfo { dInstructions } = do (3:operand:_) -> if regs Map.! 'A' == 0 then tick (pos+2) regs di - else tick operand regs di + else tick (fromIntegral operand) regs di (4:_:_) -> let result = (regs Map.! 'B') `xor` (regs Map.! 'C') in tick (pos+2) (Map.insert 'B' result regs) di - (5:operand:_) -> do - rest <- tick (pos+2) regs di - return $ (comboValue operand `mod` 8) : rest + (5:operand:_) -> (comboValue operand `mod` 8) : tick (pos+2) regs di (6:operand:_) -> let result = (regs Map.! 'A') `div` (2 ^ comboValue operand) in tick (pos+2) (Map.insert 'B' result regs) di @@ -65,9 +106,6 @@ tick pos regs di@DebuggerInfo { dInstructions } = do comboValue 6 = regs Map.! 'C' comboValue other = error $ "Illegal combo operand (" ++ (show other) ++ ") at " ++ (show pos) -task2 :: String -> IO IntType -task2 _ = return 2 - readInput :: String -> DebuggerInfo readInput input = case readP_to_S parseDebuggerInfo input of [] -> error "Failed to parse input" @@ -98,3 +136,8 @@ parseInt = do isNewLine :: Char -> Bool isNewLine = (==) '\n' + +expectJust :: String -> Maybe a -> a +expectJust message Nothing = error message +expectJust _ (Just value) = value +