Solve Day 08 (#13)

* Setup Day 08

* Solve part 1

* Solve part 2

* fix pedantic warnings

* always lint and type check

* filter out fixes that are the same as the original

* Use IntMap instead of list for the instructions

- move new utils to Day08.Utils

* add specs for utils

* add local version of stack commands

* reuse nextProgramPointer

AdventOfCode2020.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 85cdf949abc33898fb68bc532705f9a48e78f9a291a1976961440d8cfebdd4e7
+-- hash: f802520fe245b7322ed8055c9432bed44693266dfe021b196219d0695b218f5b
 
 name:           AdventOfCode2020
 version:        2.0.2.0
@@ -36,6 +36,8 @@ library
       Day04.Solution
       Day05.Solution
       Day06.Solution
+      Day08.Solution
+      Day08.Utils
       Template.Solution
   other-modules:
       Paths_AdventOfCode2020
@@ -64,6 +66,8 @@ test-suite AdventOfCode2020-test
       Day04.SolutionSpec
       Day05.SolutionSpec
       Day06.SolutionSpec
+      Day08.SolutionSpec
+      Day08.UtilsSpec
       Template.SolutionSpec
       Paths_AdventOfCode2020
   hs-source-dirs:

src/Day08/README.md

@@ -0,0 +1,98 @@
+## Day 8: Handheld Halting
+
+Your flight to the major airline hub reaches cruising altitude without incident. While you consider checking the in-flight menu for one of those drinks that come with a little umbrella, you are interrupted by the kid sitting next to you.
+
+Their [handheld game console][1] won't turn on! They ask if you can take a look.
+
+You narrow the problem down to a strange _infinite loop_ in the boot code (your puzzle input) of the device. You should be able to fix it, but first you need to be able to run the code in isolation.
+
+The boot code is represented as a text file with one _instruction_ per line of text. Each instruction consists of an _operation_ ( `acc` , `jmp` , or `nop` ) and an _argument_ (a signed number like `+4` or `-20` ).
+
+- `acc` increases or decreases a single global value called the _accumulator_ by the value given in the argument. For example, `acc +7` would increase the accumulator by 7. The accumulator starts at `0` . After an `acc` instruction, the instruction immediately below it is executed next.
+- `jmp` _jumps_ to a new instruction relative to itself. The next instruction to execute is found using the argument as an _offset_ from the `jmp` instruction; for example, `jmp +2` would skip the next instruction, `jmp +1` would continue to the instruction immediately below it, and `jmp -20` would cause the instruction 20 lines above to be executed next.
+- `nop` stands for _No OPeration_ \- it does nothing. The instruction immediately below it is executed next.
+
+For example, consider the following program:
+
+```
+nop +0
+acc +1
+jmp +4
+acc +3
+jmp -3
+acc -99
+acc +1
+jmp -4
+acc +6
+```
+
+These instructions are visited in this order:
+
+```
+nop +0  | 1
+acc +1  | 2, 8(!)
+jmp +4  | 3
+acc +3  | 6
+jmp -3  | 7
+acc -99 |
+acc +1  | 4
+jmp -4  | 5
+acc +6  |
+```
+
+First, the `nop +0` does nothing. Then, the accumulator is increased from 0 to 1 ( `acc +1` ) and `jmp +4` sets the next instruction to the other `acc +1` near the bottom. After it increases the accumulator from 1 to 2, `jmp -4` executes, setting the next instruction to the only `acc +3` . It sets the accumulator to 5, and `jmp -3` causes the program to continue back at the first `acc +1` .
+
+This is an _infinite loop_ : with this sequence of jumps, the program will run forever. The moment the program tries to run any instruction a second time, you know it will never terminate.
+
+Immediately _before_ the program would run an instruction a second time, the value in the accumulator is _`5`_ .
+
+Run your copy of the boot code. Immediately before any instruction is executed a second time, _what value is in the accumulator?_
+
+## Part Two
+
+After some careful analysis, you believe that _exactly one instruction is corrupted_ .
+
+Somewhere in the program, _either_ a `jmp` is supposed to be a `nop` , _or_ a `nop` is supposed to be a `jmp` . (No `acc` instructions were harmed in the corruption of this boot code.)
+
+The program is supposed to terminate by _attempting to execute an instruction immediately after the last instruction in the file_ . By changing exactly one `jmp` or `nop` , you can repair the boot code and make it terminate correctly.
+
+For example, consider the same program from above:
+
+```
+nop +0
+acc +1
+jmp +4
+acc +3
+jmp -3
+acc -99
+acc +1
+jmp -4
+acc +6
+```
+
+If you change the first instruction from `nop +0` to `jmp +0` , it would create a single-instruction infinite loop, never leaving that instruction. If you change almost any of the `jmp` instructions, the program will still eventually find another `jmp` instruction and loop forever.
+
+However, if you change the second-to-last instruction (from `jmp -4` to `nop -4` ), the program terminates! The instructions are visited in this order:
+
+```
+nop +0  | 1
+acc +1  | 2
+jmp +4  | 3
+acc +3  |
+jmp -3  |
+acc -99 |
+acc +1  | 4
+nop -4  | 5
+acc +6  | 6
+```
+
+After the last instruction ( `acc +6` ), the program terminates by attempting to run the instruction below the last instruction in the file. With this change, after the program terminates, the accumulator contains the value _`8`_ ( `acc +1` , `acc +1` , `acc +6` ).
+
+Fix the program so that it terminates normally by changing exactly one `jmp` (to `nop` ) or `nop` (to `jmp` ). _What is the value of the accumulator after the program terminates?_
+
+## Link
+
+[https://adventofcode.com/2020/day/8][2]
+
+[1]: https://en.wikipedia.org/wiki/Handheld_game_console
+[2]: https://adventofcode.com/2020/day/8

src/Day08/Solution.hs

@@ -0,0 +1,106 @@
+module Day08.Solution
+  ( part1,
+    part2,
+    Instruction (..),
+    Sign (..),
+    Operation (..),
+    Program (..),
+    parseInstructions,
+    runProgram,
+    initialState,
+    fixedInstructions,
+    fixProgram,
+  )
+where
+
+import Advent.Utils (readInt)
+import Data.Either (isRight)
+import qualified Data.IntMap.Strict as IntMap
+import qualified Data.IntSet as IntSet
+import Day08.Utils (asIntMap, fromLeftOrError, fromRightOrError')
+import Text.Parsec
+
+part1 :: String -> String
+part1 = show . programAcc . fromLeftOrError . runProgram initialState . fromRightOrError' . parseInstructions
+
+part2 :: String -> String
+part2 = show . programAcc . fromRightOrError' . fixProgram initialState . fromRightOrError' . parseInstructions
+
+data Sign = Plus | Minus deriving (Show, Eq)
+
+data Operation = NoOperation | Accumulator | Jump deriving (Show, Eq)
+
+data Instruction = Instruction Operation Sign Int deriving (Show, Eq)
+
+type Instructions = IntMap.IntMap Instruction
+
+parseInstructions :: String -> Either ParseError Instructions
+parseInstructions = parse instructionsParser ""
+  where
+    instructionsParser :: Parsec String () Instructions
+    instructionsParser = asIntMap <$> instructionParser `sepEndBy1` endOfLine
+
+instructionParser :: Parsec String () Instruction
+instructionParser = Instruction <$> (operationParser <* space) <*> signParser <*> intParser
+
+operationParser :: Parsec String () Operation
+operationParser = readOperation <$> many1 letter
+  where
+    readOperation "nop" = NoOperation
+    readOperation "acc" = Accumulator
+    readOperation "jmp" = Jump
+    readOperation _ = error "this should never happen"
+
+signParser :: Parsec String () Sign
+signParser = readSign <$> choice [char '+', char '-']
+  where
+    readSign '+' = Plus
+    readSign '-' = Minus
+    readSign _ = error "this should never happen"
+
+intParser :: Parsec String () Int
+intParser = readInt <$> many1 digit
+
+data Program = Program {programAcc :: Int, programPointer :: Int, programVisited :: IntSet.IntSet} deriving (Show, Eq)
+
+initialState :: Program
+initialState = Program {programAcc = 0, programPointer = 0, programVisited = IntSet.empty}
+
+runProgram :: Program -> Instructions -> Either Program Program
+runProgram program instructions
+  | programPointer program `IntSet.member` programVisited program = Left program
+  | programPointer program == length instructions = Right program
+  | otherwise = runProgram (go (instructions IntMap.! programPointer program)) instructions
+  where
+    nextProgram = program {programVisited = programPointer program `IntSet.insert` programVisited program}
+    nextProgramPointer = (succ . programPointer) program
+    go :: Instruction -> Program
+    go (Instruction NoOperation _ _) = nextProgram {programPointer = (succ . programPointer) nextProgram}
+    go (Instruction Jump Plus n) = nextProgram {programPointer = ((+) n . programPointer) nextProgram}
+    go (Instruction Jump Minus n) = nextProgram {programPointer = (subtract n . programPointer) nextProgram}
+    go (Instruction Accumulator Plus n) =
+      nextProgram
+        { programPointer = nextProgramPointer,
+          programAcc = ((+) n . programAcc) nextProgram
+        }
+    go (Instruction Accumulator Minus n) =
+      nextProgram
+        { programPointer = nextProgramPointer,
+          programAcc = (subtract n . programAcc) nextProgram
+        }
+
+fixProgram :: Program -> Instructions -> Either Program Program
+fixProgram program = head . filter isRight . map (runProgram program) . fixedInstructions
+
+fixedInstructions :: Instructions -> [Instructions]
+fixedInstructions instructions =
+  [ IntMap.adjust swappedInstruction i instructions
+    | i <- [0 .. (length instructions)],
+      let (Instruction op _ _) = instructions IntMap.! i,
+      op == NoOperation || op == Jump
+  ]
+  where
+    swappedInstruction :: Instruction -> Instruction
+    swappedInstruction (Instruction NoOperation sign int) = Instruction Jump sign int
+    swappedInstruction (Instruction Jump sign int) = Instruction NoOperation sign int
+    swappedInstruction _ = error "this should never happen"

src/Day08/Utils.hs

@@ -0,0 +1,22 @@
+module Day08.Utils where
+
+import qualified Data.IntMap.Strict as IntMap
+
+asIntMap :: [a] -> IntMap.IntMap a
+asIntMap = IntMap.fromList . zip [0 ..]
+
+-- http://hackage.haskell.org/package/either-5.0.1.1/docs/Data-Either-Combinators.html
+-- as `fromLeft'`
+fromLeftOrError :: Either a b -> a
+fromLeftOrError (Right _) = error "fromLeftOrError: Argument takes form 'Right _'"
+fromLeftOrError (Left x) = x
+
+-- http://hackage.haskell.org/package/either-5.0.1.1/docs/Data-Either-Combinators.html
+-- as `fromRight'`
+fromRightOrError :: Either a b -> b
+fromRightOrError (Left _) = error "fromRightOrError: Argument takes form 'Left _'"
+fromRightOrError (Right x) = x
+
+fromRightOrError' :: Show a => Either a b -> b
+fromRightOrError' (Left x) = error (show x)
+fromRightOrError' (Right x) = x

test/Day08/SolutionSpec.hs

@@ -0,0 +1,65 @@
+module Day08.SolutionSpec (spec) where
+
+import Data.Foldable (for_)
+import qualified Data.IntMap.Strict as IntMap
+import Day08.Solution
+  ( Instruction (..),
+    Operation (..),
+    Program (..),
+    Sign (..),
+    fixProgram,
+    fixedInstructions,
+    initialState,
+    parseInstructions,
+    part1,
+    part2,
+    runProgram,
+  )
+import Day08.Utils (asIntMap, fromLeftOrError)
+import Test.Hspec
+
+spec :: Spec
+spec = parallel $ do
+  it "solves Part 1" $ do
+    input <- readFile "./test/Day08/input.txt"
+    part1 input `shouldBe` "1317"
+  it "solves Part 2" $ do
+    input <- readFile "./test/Day08/input.txt"
+    part2 input `shouldBe` "1033"
+  let parsedExample =
+        asIntMap
+          [ Instruction NoOperation Plus 0,
+            Instruction Accumulator Plus 1,
+            Instruction Jump Plus 4,
+            Instruction Accumulator Plus 3,
+            Instruction Jump Minus 3,
+            Instruction Accumulator Minus 99,
+            Instruction Accumulator Plus 1,
+            Instruction Jump Minus 4,
+            Instruction Accumulator Plus 6
+          ]
+  describe "parseInstructions" $ do
+    it "parses the example into instructions" $ do
+      input <- readFile "./test/Day08/example.txt"
+      parseInstructions input `shouldBe` Right parsedExample
+
+  describe "runProgram" $ do
+    context "given instructions from example.txt" $ do
+      it "has an accumulator of 5" $ do
+        (programAcc . fromLeftOrError . runProgram initialState) parsedExample `shouldBe` 5
+  describe "fixProgram" $ do
+    context "given instructions from example.txt" $ do
+      it "has an accumulator of 5" $ do
+        programAcc <$> fixProgram initialState parsedExample `shouldBe` Right 8
+
+  describe "fixInstructions" $ do
+    context "given instructions from example.txt" $ do
+      let cases =
+            [ (0, 0, Instruction Jump Plus 0),
+              (1, 2, Instruction NoOperation Plus 4),
+              (2, 4, Instruction NoOperation Minus 3),
+              (3, 7, Instruction NoOperation Minus 4)
+            ]
+          test (x, y, expected) = it ("swaps the instructions to " ++ show expected) $ do
+            fixedInstructions parsedExample !! x IntMap.! y `shouldBe` expected
+       in for_ cases test

test/Day08/UtilsSpec.hs

@@ -0,0 +1,33 @@
+module Day08.UtilsSpec (spec) where
+
+import Control.Exception (evaluate)
+import qualified Data.IntMap.Strict as IntMap
+import Day08.Utils (asIntMap, fromLeftOrError, fromRightOrError, fromRightOrError')
+import Test.Hspec
+
+spec :: Spec
+spec = parallel $ do
+  describe "asIntMap" $ do
+    it "converts a list to an IntMap" $ do
+      asIntMap ["day 1", "day 2", "day 3", "day 4"] `shouldBe` IntMap.fromList [(0, "day 1"), (1, "day 2"), (2, "day 3"), (3, "day 4")]
+  describe "fromLeftOrError" $ do
+    context "given a Left Value" $ do
+      it "is the Left value" $ do
+        fromLeftOrError (Left 42) `shouldBe` 42
+    context "given a Right Value" $ do
+      it "is throws an exceptions" $ do
+        evaluate (fromLeftOrError (Right 42)) `shouldThrow` anyException
+  describe "fromRightOrError" $ do
+    context "given a Right Value" $ do
+      it "is the Right value" $ do
+        fromRightOrError (Right 53) `shouldBe` 53
+    context "given a Left Value" $ do
+      it "is throws an exceptions" $ do
+        evaluate (fromRightOrError (Left 21)) `shouldThrow` anyException
+  describe "fromRightOrError'" $ do
+    context "given a Right Value" $ do
+      it "is the Right value" $ do
+        fromRightOrError' (Right 92 :: Either Int Int) `shouldBe` 92
+    context "given a Left Value" $ do
+      it "is throws an exceptions" $ do
+        evaluate (fromRightOrError' (Left 14 :: Either Int Int)) `shouldThrow` anyException

test/Day08/example.txt

@@ -0,0 +1,9 @@
+nop +0
+acc +1
+jmp +4
+acc +3
+jmp -3
+acc -99
+acc +1
+jmp -4
+acc +6