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

Bad Haskell, Debug.Trace ftw!

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 initialVM ins = VM 1 0 ins VMRun
stepVM :: VirtualMachine -> Maybe (VirtualMachine, VirtualMachine) 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 where
next = go (ins V.! (c-1))
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 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 lastCount = V.length ins
stepVM (VM _ _ _ VMHalt) = Nothing 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 -- Try lots of permutations of OpNop -> OpJmp, or OpJmp -> OpNop
-- until the VirtualMachine halts, and read the value of the accumulator -- until the VirtualMachine halts, and read the value of the accumulator
solvePart2 :: Vector Op -> Vector Int solvePart2 :: Vector Op -> Vector VMState
solvePart2 = fmap (pgmAccumulator . last . shortestCycleVm . unfoldr stepVM . initialVM) . swapInstructions solvePart2 = fmap (vmState . last . shortestCycleVm . unfoldr stepVM . initialVM) . swapInstructions
swapInstructions :: Vector Op -> Vector (Vector Op) swapInstructions :: Vector Op -> Vector (Vector Op)
swapInstructions ins = V.imapM swap ins swapInstructions ins = V.imap swap ins
where where
-- swap i (OpNop v) = ins V.// [(i,OpJmp v)] swap i (OpNop v) = ins V.// [(i,OpJmp v)]
-- swap i (OpJmp v) = ins V.// [(i,OpNop v)] swap i (OpJmp v) = ins V.// [(i,OpNop v)]
-- swap _ (OpAcc _) = ins swap _ (OpAcc _) = ins
swap _ _ = ins
main :: IO () main :: IO ()
main = do main = do
@ -126,7 +131,10 @@ main = do
putStrLn ":: Tests" putStrLn ":: Tests"
let miniIns = V.fromList [OpJmp 2, OpNop 0, OpAcc (-8)] let miniIns = V.fromList [OpJmp 2, OpNop 0, OpAcc (-8)]
pPrint $ length $ swapInstructions $ miniIns 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" putStrLn ":: Solving part 2"
--pPrint $ solvePart2 $ V.fromList $ parseOp <$> exampleData pPrint $ solvePart2 $ V.fromList $ parseOp <$> exampleData
pPrint $ solvePart2 $ V.fromList $ parseOp <$> input