Day seventeen part two

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]
+data BruteResult = Negative | Positive IntType Int | Finished IntType Int
-tick pos regs di@DebuggerInfo { dInstructions } = do
+  deriving (Eq)
-  print regs
+
+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
+    (5:operand:_) -> (comboValue operand `mod` 8) : tick (pos+2) regs di
-      rest <- tick (pos+2) regs di
-      return $ (comboValue operand `mod` 8) : rest
     (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
+