Day 8 - still in progress

day8/main.hs

@@ -4,7 +4,7 @@
 #! nix-shell -i "ghcid -c 'ghci' -T main"
 
 {-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns #-}
-{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+{-# OPTIONS_GHC -Wno-unused-top-binds -Wno-unused-local-binds #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 import Text.Pretty.Simple
@@ -12,17 +12,17 @@ import Text.Pretty.Simple
 -- import qualified Data.List.NonEmpty as NE
 import Data.Vector (Vector)
 import Debug.Trace (trace)
-import Data.List (unfoldr)
+import Data.List (unfoldr, zip4, unzip4)
 import Data.IntMap.Strict (IntMap)
 import qualified Data.Vector as V
 import qualified Data.IntMap.Strict as M
 
-data Op = OpNop
+data Op = OpNop !Int
         | OpJmp !Int
         | OpAcc !Int
   deriving (Show, Ord, Eq)
 
-data VMState = VMRun
+data VMState = VMRun | VMHalt
   deriving (Show, Ord, Eq)
 
 data VirtualMachine = VM
@@ -37,11 +37,15 @@ initialVM :: Vector Op -> VirtualMachine
 initialVM ins = VM 1 0 ins VMRun
 
 stepVM :: VirtualMachine -> Maybe (VirtualMachine, VirtualMachine)
-stepVM vm@(VM c a ins VMRun) = Just (vm, go (ins V.! (c-1)))
+stepVM vm@(VM c a ins VMRun) = Just (vm, checkHalt (go (ins V.! (c-1))))
   where
-    go OpNop     = VM (c+1) a     ins VMRun
+    go (OpNop _)        = VM (c+1) a     ins VMRun
-    go (OpJmp n) = VM (c+n) a     ins VMRun
+    go (OpJmp n)        = VM (c+n) a     ins VMRun
-    go (OpAcc n) = VM (c+1) (a+n) ins VMRun
+    go (OpAcc n)        = VM (c+1) (a+n) ins VMRun
+    checkHalt vm0@(VM c0 _ _ _) | c0 == lastCount = vm0 { vmState = VMHalt}
+    checkHalt vm0@(VM _ _ _ _)  | otherwise = vm0
+    lastCount = V.length ins
+stepVM (VM _ _ _ VMHalt) = Nothing
 
 exampleData :: [String]
 exampleData =
@@ -59,14 +63,18 @@ exampleData =
 vmFromInput :: [String] -> VirtualMachine
 vmFromInput input = initialVM (ins input)
   where
-    ins = V.fromList . (map (parseOp . (\(x,y)-> (x,tail y)) . break (== ' ')))
+    ins = V.fromList . map parseOp
-    parseOp :: (String,String) -> Op
+
-    parseOp ("nop",_)     = OpNop
+parseOp :: String -> Op
-    parseOp ("acc",'+':s) = OpAcc (read s :: Int)
+parseOp = go . (\(x,y)-> (x,tail y)) . break (== ' ')
-    parseOp ("jmp",'+':s) = OpJmp (read s :: Int)
+  where
-    parseOp ("acc",s) = OpAcc (read s :: Int)
+    go ("nop",'+':s) = OpNop (read s :: Int)
-    parseOp ("jmp",s) = OpJmp (read s :: Int)
+    go ("acc",'+':s) = OpAcc (read s :: Int)
-    parseOp s@_ = trace (show s) $ undefined
+    go ("jmp",'+':s) = OpJmp (read s :: Int)
+    go ("nop",s) = OpNop (read s :: Int)
+    go ("acc",s) = OpAcc (read s :: Int)
+    go ("jmp",s) = OpJmp (read s :: Int)
+    go s@_ = trace (show s) $ undefined
 
 -- Find smallest looping prefix in list of Int, returns associated pgmAccumulator
 solvePart1 :: VirtualMachine -> Int
@@ -87,12 +95,38 @@ shortestCycleOn tx = zip (shortestCycle cx) ax
   where
     (cx, ax) = unzip tx
 
+shortestCycleVm :: [VirtualMachine] -> [VirtualMachine]
+shortestCycleVm vx = (\(a,b,c,d) -> VM a b c d) <$> zip4 (shortestCycle cx) ax ins state
+  where
+    (cx, ax, ins, state) = unzip4 $ (\(VM a b c d) -> (a,b,c,d)) <$> vx
+
+-- Try lots of permutations of OpNop -> OpJmp, or OpJmp -> OpNop
+-- until the VirtualMachine halts, and read the value of the accumulator
+solvePart2 :: Vector Op -> Vector Int
+solvePart2 = fmap (pgmAccumulator . last . shortestCycleVm . unfoldr stepVM . initialVM) . swapInstructions
+
+swapInstructions :: Vector Op -> Vector (Vector Op)
+swapInstructions ins = V.imapM swap ins
+  where
+    -- swap i (OpNop v) = ins V.// [(i,OpJmp v)]
+    -- swap i (OpJmp v) = ins V.// [(i,OpNop v)]
+    -- swap _ (OpAcc _) = ins
+    swap _ _ = ins
+
 main :: IO ()
 main = do
   putStrLn "Day 8 - Part 1"
   putStrLn ":: Tests"
-  pPrint exampleData
+  print exampleData
+  print $ parseOp <$> exampleData
   putStrLn ":: Solving part 1"
   pPrint $ solvePart1 (vmFromInput exampleData)
   input <- lines <$> readFile "day8/input"
   pPrint $ solvePart1 (vmFromInput input)
+  putStrLn ":: Tests"
+  let miniIns = V.fromList [OpJmp 2, OpNop 0, OpAcc (-8)]
+  pPrint $ length $ swapInstructions $ miniIns
+  pPrint $ miniIns V.// [(0,OpNop (-1))]
+  putStrLn ":: Solving part 2"
+  --pPrint $ solvePart2 $ V.fromList $ parseOp <$> exampleData
+