mpo/adventofcode-2020
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Bad Haskell, Debug.Trace ftw!

Browse source
This commit is contained in:
Martin Potier 2020-12-10 12:49:39 +02:00
parent 4faaf34bf8
commit 09ca90be06
No known key found for this signature in database
GPG key ID: D4DD957DBA4AD89E
1 changed files with 20 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
day8/main.hs
View file

@ -37,13 +37,19 @@ 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, checkHalt (go (ins V.! (c-1))))
stepVM current@(VM c a ins VMRun) = Just (current, checkHalt next)
where
next = go (ins V.! (c-1))
go (OpNop _) = VM (c+1) a ins VMRun
go (OpJmp n) = VM (c+n) a 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
checkHalt vm0@(VM c0 a0 _ _) | c0 == lastCount + 1 =
trace ("halted, acc="<>show a0) $ vm0 { vmState = VMHalt }
checkHalt vm0@(VM _ _ _ _) | otherwise =
vm0
lastCount = V.length ins
stepVM (VM _ _ _ VMHalt) = Nothing
@ -102,16 +108,15 @@ shortestCycleVm vx = (\(a,b,c,d) -> VM a b c d) <$> zip4 (shortestCycle cx) ax i
-- 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
solvePart2 :: Vector Op -> Vector VMState
solvePart2 = fmap (vmState . last . shortestCycleVm . unfoldr stepVM . initialVM) . swapInstructions
swapInstructions :: Vector Op -> Vector (Vector Op)
swapInstructions ins = V.imapM swap ins
swapInstructions ins = V.imap 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
swap i (OpNop v) = ins V.// [(i,OpJmp v)]
swap i (OpJmp v) = ins V.// [(i,OpNop v)]
swap _ (OpAcc _) = ins
main :: IO ()
main = do
@ -126,7 +131,10 @@ main = do
putStrLn ":: Tests"
let miniIns = V.fromList [OpJmp 2, OpNop 0, OpAcc (-8)]
pPrint $ length $ swapInstructions $ miniIns
pPrint $ miniIns V.// [(0,OpNop (-1))]
let miniVM = initialVM $ V.fromList [ OpNop 0 ]
pPrint $ miniVM { vmState = VMHalt }
pPrint $ (unfoldr stepVM) $ miniVM
putStrLn ":: Solving part 2"
--pPrint $ solvePart2 $ V.fromList $ parseOp <$> exampleData
pPrint $ solvePart2 $ V.fromList $ parseOp <$> exampleData
pPrint $ solvePart2 $ V.fromList $ parseOp <$> input