pull/1/head
Gaël Depreeuw 5 years ago
parent 6b507bc436
commit 5d482a4230
  1. 9
      app/Main.hs
  2. 1
      app/input_day5
  3. 3
      package.yaml
  4. 132
      src/Day5.hs

@ -4,6 +4,7 @@ import Day1
import Day2
import Day3
import Day4
import Day5
import System.IO
import Data.List.Split
import Data.Set
@ -17,7 +18,7 @@ day2_instructions :: String -> [Integer]
day2_instructions = fmap read . splitOn ","
day2 :: (Integer, Integer) -> [Integer] -> Integer
day2 t = head . execute t
day2 t = head . Day2.execute t
day2_look :: [Integer] -> Integer
day2_look xs = head $ [ 100*noun + verb |
@ -46,4 +47,8 @@ main = do
print getNumberOfPasswords
putStr "[Day 4-2] Result: "
print getNumberOfPasswords'
r_day5 <- readFile "./app/input_day5"
putStr "[Day 5-1] Result: "
print . last $ Day5.execute 1 r_day5
putStr "[Day 5-2] Result: "
print . last $ Day5.execute 5 r_day5

@ -0,0 +1 @@
3,225,1,225,6,6,1100,1,238,225,104,0,1101,61,45,225,102,94,66,224,101,-3854,224,224,4,224,102,8,223,223,1001,224,7,224,1,223,224,223,1101,31,30,225,1102,39,44,224,1001,224,-1716,224,4,224,102,8,223,223,1001,224,7,224,1,224,223,223,1101,92,41,225,101,90,40,224,1001,224,-120,224,4,224,102,8,223,223,1001,224,1,224,1,223,224,223,1101,51,78,224,101,-129,224,224,4,224,1002,223,8,223,1001,224,6,224,1,224,223,223,1,170,13,224,101,-140,224,224,4,224,102,8,223,223,1001,224,4,224,1,223,224,223,1101,14,58,225,1102,58,29,225,1102,68,70,225,1002,217,87,224,101,-783,224,224,4,224,102,8,223,223,101,2,224,224,1,224,223,223,1101,19,79,225,1001,135,42,224,1001,224,-56,224,4,224,102,8,223,223,1001,224,6,224,1,224,223,223,2,139,144,224,1001,224,-4060,224,4,224,102,8,223,223,101,1,224,224,1,223,224,223,1102,9,51,225,4,223,99,0,0,0,677,0,0,0,0,0,0,0,0,0,0,0,1105,0,99999,1105,227,247,1105,1,99999,1005,227,99999,1005,0,256,1105,1,99999,1106,227,99999,1106,0,265,1105,1,99999,1006,0,99999,1006,227,274,1105,1,99999,1105,1,280,1105,1,99999,1,225,225,225,1101,294,0,0,105,1,0,1105,1,99999,1106,0,300,1105,1,99999,1,225,225,225,1101,314,0,0,106,0,0,1105,1,99999,1008,677,226,224,102,2,223,223,1006,224,329,101,1,223,223,108,677,677,224,102,2,223,223,1005,224,344,101,1,223,223,107,677,677,224,1002,223,2,223,1005,224,359,101,1,223,223,1107,226,677,224,1002,223,2,223,1005,224,374,1001,223,1,223,1008,677,677,224,102,2,223,223,1006,224,389,1001,223,1,223,1007,677,677,224,1002,223,2,223,1006,224,404,1001,223,1,223,8,677,226,224,102,2,223,223,1005,224,419,1001,223,1,223,8,226,226,224,102,2,223,223,1006,224,434,101,1,223,223,1107,226,226,224,1002,223,2,223,1006,224,449,101,1,223,223,1107,677,226,224,102,2,223,223,1005,224,464,101,1,223,223,1108,226,226,224,102,2,223,223,1006,224,479,1001,223,1,223,7,677,677,224,1002,223,2,223,1006,224,494,101,1,223,223,7,677,226,224,102,2,223,223,1005,224,509,101,1,223,223,1108,226,677,224,1002,223,2,223,1006,224,524,101,1,223,223,8,226,677,224,1002,223,2,223,1005,224,539,101,1,223,223,1007,226,226,224,102,2,223,223,1006,224,554,1001,223,1,223,108,226,226,224,1002,223,2,223,1006,224,569,1001,223,1,223,1108,677,226,224,102,2,223,223,1005,224,584,101,1,223,223,108,226,677,224,102,2,223,223,1005,224,599,101,1,223,223,1007,226,677,224,102,2,223,223,1006,224,614,1001,223,1,223,1008,226,226,224,1002,223,2,223,1006,224,629,1001,223,1,223,107,226,226,224,1002,223,2,223,1006,224,644,101,1,223,223,7,226,677,224,102,2,223,223,1005,224,659,1001,223,1,223,107,677,226,224,102,2,223,223,1005,224,674,1001,223,1,223,4,223,99,226

@ -23,6 +23,9 @@ dependencies:
- base >= 4.7 && < 5
- containers >= 0.6
- split >= 0.1
- text >= 1.2
- attoparsec >= 0.13
- vector >= 0.12
library:
source-dirs: src

@ -0,0 +1,132 @@
module Day5
(
module Day5
) where
import Data.Char
import Data.Maybe
import Control.Applicative
import qualified Data.Text as T
import qualified Data.Attoparsec.Text as P
import qualified Data.Vector as V
type ADDRp = Int
type ADDRi = Integer
type ADDR = Either ADDRp ADDRi
type INPUT = Integer
type OUTPUT = Integer
data Instruction = ADD ADDR ADDR ADDRp
| MUL ADDR ADDR ADDRp
| STORE ADDRp
| LOAD ADDRp
| JMPT ADDR ADDR
| JMPF ADDR ADDR
| LT' ADDR ADDR ADDRp
| EQ' ADDR ADDR ADDRp
| HALT
deriving (Show)
execute :: INPUT -> String -> [OUTPUT]
execute i s = maybe [] (runProgram i) $ parseProgram (T.pack s)
type Program = V.Vector Integer
type PC = Int
type RunningProg = (INPUT, Program, PC, [OUTPUT])
parseProgram :: T.Text -> Maybe Program
parseProgram = fmap V.fromList . P.maybeResult . parseNumbers
where parseNumbers = P.parse (P.sepBy1 (P.signed P.decimal) (P.char ','))
runProgram :: INPUT -> Program -> [OUTPUT]
runProgram i p = go i p 0 []
where go i' p' pc outputs =
let inst = parseInstruction p' pc in
case inst of
HALT -> outputs
_ -> let (i'', p'',pc', outputs') = executeInstruction (i', p', pc, outputs) inst in
outputs ++ go i'' p'' pc' outputs'
parseInstruction :: Program -> PC -> Instruction
parseInstruction p i =
let inst = p V.! i
a = (inst `div` 10000) /= 0
b = (inst `mod` 10000) `div` 1000 /= 0
c = (inst `mod` 1000) `div` 100 /= 0
de = (inst `mod` 100)
addr b a = if b then Right a else Left (fromInteger a)
in
case de of
1 -> ADD (addr c (p V.! (i+1)))
(addr b (p V.! (i+2)))
(fromInteger (p V.! (i+3)))
2 -> MUL (addr c (p V.! (i+1)))
(addr b (p V.! (i+2)))
(fromInteger (p V.! (i+3)))
3 -> STORE $ fromInteger (p V.! (i+1))
4 -> LOAD $ fromInteger (p V.! (i+1))
5 -> JMPT (addr c (p V.! (i+1))) (addr b (p V.! (i+2)))
6 -> JMPF (addr c (p V.! (i+1))) (addr b (p V.! (i+2)))
7 -> LT' (addr c (p V.! (i+1)))
(addr b (p V.! (i+2)))
(fromInteger (p V.! (i+3)))
8 -> EQ' (addr c (p V.! (i+1)))
(addr b (p V.! (i+2)))
(fromInteger (p V.! (i+3)))
99 -> HALT
_ -> error $ "unknown instruction " ++ show ((a,b,c), de)
executeInstruction :: RunningProg -> Instruction -> RunningProg
executeInstruction (input, p, pc, outputs) i =
case i of
ADD (Left a) (Left b) c ->
(input, p V.// [(c, (p V.! a) + (p V.! b))], pc + 4, outputs)
ADD (Left a) (Right b) c ->
(input, p V.// [(c, (p V.! a) + b)], pc + 4, outputs)
ADD (Right a) (Left b) c ->
(input, p V.// [(c, a + (p V.! b))], pc + 4, outputs)
ADD (Right a) (Right b) c ->
(input, p V.// [(c, a + b)], pc + 4, outputs)
MUL (Left a) (Left b) c ->
(input, p V.// [(c, (p V.! a) * (p V.! b))], pc + 4, outputs)
MUL (Left a) (Right b) c ->
(input, p V.// [(c, (p V.! a) * b)], pc + 4, outputs)
MUL (Right a) (Left b) c ->
(input, p V.// [(c, a * (p V.! b))], pc + 4, outputs)
MUL (Right a) (Right b) c ->
(input, p V.// [(c, a * b)], pc + 4, outputs)
STORE a -> (input, p V.// [(a, input)], pc + 2, outputs)
LOAD a -> (input, p, pc + 2, outputs ++ [p V.! a])
JMPT (Left a) (Left b) ->
(input, p, if (p V.! a) /= 0 then fromInteger (p V.! b) else pc + 3, outputs)
JMPT (Left a) (Right b) ->
(input, p, if (p V.! a) /= 0 then fromInteger b else pc + 3, outputs)
JMPT (Right a) (Left b) ->
(input, p, if a /= 0 then fromInteger (p V.! b) else pc + 3, outputs)
JMPT (Right a) (Right b) ->
(input, p, if a /= 0 then fromInteger b else pc + 3, outputs)
JMPF (Left a) (Left b) ->
(input, p, if (p V.! a) == 0 then fromInteger (p V.! b) else pc + 3, outputs)
JMPF (Left a) (Right b) ->
(input, p, if (p V.! a) == 0 then fromInteger b else pc + 3, outputs)
JMPF (Right a) (Left b) ->
(input, p, if a == 0 then fromInteger (p V.! b) else pc + 3, outputs)
JMPF (Right a) (Right b) ->
(input, p, if a == 0 then fromInteger b else pc + 3, outputs)
LT' (Left a) (Left b) c ->
(input, p V.// [(c, if (p V.! a) < (p V.! b) then 1 else 0)], pc + 4, outputs)
LT' (Left a) (Right b) c ->
(input, p V.// [(c, if (p V.! a) < b then 1 else 0)], pc + 4, outputs)
LT' (Right a) (Left b) c ->
(input, p V.// [(c, if a < (p V.! b) then 1 else 0)], pc + 4, outputs)
LT' (Right a) (Right b) c ->
(input, p V.// [(c, if a < b then 1 else 0)], pc + 4, outputs)
EQ' (Left a) (Left b) c ->
(input, p V.// [(c, if (p V.! a) == (p V.! b) then 1 else 0)], pc + 4, outputs)
EQ' (Left a) (Right b) c ->
(input, p V.// [(c, if (p V.! a) == b then 1 else 0)], pc + 4, outputs)
EQ' (Right a) (Left b) c ->
(input, p V.// [(c, if a == (p V.! b) then 1 else 0)], pc + 4, outputs)
EQ' (Right a) (Right b) c ->
(input, p V.// [(c, if a == b then 1 else 0)], pc + 4, outputs)
_ -> (input, p, pc + 1, outputs)
Loading…
Cancel
Save