Mithror
/
AdventOfCode2019
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Day7

Browse Source
pull/1/head
Gaël Depreeuw 5 years ago
parent 84c70f3f43
commit 91c6214e65
4 changed files with 234 additions and 0 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 6
      app/Main.hs
  2. 1
      app/input_day7
  3. 49
      src/Day7.hs
  4. 178
      src/IntCode.hs

6
app/Main.hs
Unescape View File

@ -6,6 +6,7 @@ import Day3
import Day4 import Day4
import Day5 import Day5
import Day6 import Day6
import Day7
import System.IO import System.IO
import Data.List.Split import Data.List.Split
import Data.Set import Data.Set
@ -58,3 +59,8 @@ main = do
print $ countOrbits r_day6 print $ countOrbits r_day6
putStr "[Day 6-2] Result: " putStr "[Day 6-2] Result: "
print $ nOrbits r_day6 print $ nOrbits r_day6
r_day7 <- readFile "./app/input_day7"
putStr "[Day 7-1] Result: "
print $ findMaxAmp r_day7
putStr "[Day 7-2] Result: "
print $ findMaxAmpWithFB r_day7

1
app/input_day7
Unescape View File

@ -0,0 +1 @@
3,8,1001,8,10,8,105,1,0,0,21,34,51,68,89,98,179,260,341,422,99999,3,9,1001,9,4,9,102,4,9,9,4,9,99,3,9,1002,9,5,9,1001,9,2,9,1002,9,2,9,4,9,99,3,9,1001,9,3,9,102,3,9,9,101,4,9,9,4,9,99,3,9,102,2,9,9,101,2,9,9,1002,9,5,9,1001,9,2,9,4,9,99,3,9,102,2,9,9,4,9,99,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,99,3,9,1001,9,1,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,1,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,1,9,9,4,9,3,9,1001,9,2,9,4,9,99,3,9,101,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,99,3,9,1001,9,1,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,101,2,9,9,4,9,3,9,101,2,9,9,4,9,99,3,9,1002,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,1001,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,1,9,9,4,9,99

49
src/Day7.hs
Unescape View File

@ -0,0 +1,49 @@
module Day7
(
module Day7
) where
import IntCode
import Data.List
import Debug.Trace
import Data.Maybe
findMaxAmp :: String -> Integer
findMaxAmp p = maximum (fmap (`calculateAmpForPhases` p) (permutations [0..4]))
calculateAmpForPhases :: [Integer] -> String -> Integer
calculateAmpForPhases phases p = foldr f 0 $ reverse phases
where f a b = calculateAmp a b p
calculateAmp :: Integer -> Integer -> String -> Integer
calculateAmp phase input = fromJust
. snd
. getOutput
. flip runProgram (Just input)
. flip runProgram (Just phase)
. parseProgram
findMaxAmpWithFB :: String -> Integer
findMaxAmpWithFB s =
let p = parseProgram s
allInits = fmap (\a -> feedPhases (zip a (replicate 5 p)))
(permutations [5..9])
allRuns = fmap (runRest 0) allInits
in
maximum allRuns
feedPhases :: [(Input, Program)] -> [Program]
feedPhases = fmap (\(a, p) -> runProgram p (Just a))
runRest :: Input -> [Program] -> Output
runRest i ps =
if isHalted (last ps)
then i
else let (ps', o) = runLoop i ps in runRest o ps'
runLoop :: Input -> [Program] -> ([Program], Output)
runLoop i [] = ([],i)
runLoop i (x:xs) =
let (p, mo) = getOutput $ runProgram x (Just i)
(ps, o) = runLoop (fromJust mo) xs in
(p : ps, o)

178
src/IntCode.hs
Unescape View File

@ -0,0 +1,178 @@
{-# LANGUAGE OverloadedStrings #-}
module IntCode
(
Input
, Output
, Program(..)
, parseProgram
, runProgram
, getOutput
, isHalted
) 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
data ADDR = POSITION Int
| IMMEDIATE Integer
deriving (Show)
type Input = Integer
type Output = Integer
data Instruction = ADD ADDR ADDR Int
| MUL ADDR ADDR Int
| STORE Int
| LOAD Int
| JMPT ADDR ADDR
| JMPF ADDR ADDR
| LT' ADDR ADDR Int
| EQ' ADDR ADDR Int
| HALT
deriving (Show)
type Memory = V.Vector Integer
type PC = Int
-- type RunningProg = ([Input], Memory, PC, [Output])
data Program = RUNNING { memory :: Memory
, pc ::PC
, output :: Maybe Output }
| WAITING { memory :: Memory
, pc ::PC
, output :: Maybe Output }
| HALTED { outputs :: Output }
deriving (Show)
parseProgram :: String -> Program
parseProgram s = WAITING (parseMemory (T.pack s)) 0 Nothing
parseMemory :: T.Text -> Memory
parseMemory t =
let parsed = P.parse (P.sepBy1 (P.signed P.decimal) (P.char ',')) t in
case parsed of
P.Done _ r -> V.fromList r
P.Partial f -> V.fromList $
fromMaybe []
(P.maybeResult (P.feed parsed ""))
_ -> V.empty
getOutput :: Program -> (Program, Maybe Output)
getOutput (HALTED o) = (HALTED o, Just o)
getOutput (RUNNING m c o) = (RUNNING m c Nothing, o)
getOutput (WAITING m c o) = (WAITING m c Nothing, o)
isHalted :: Program -> Bool
isHalted HALTED{} = True
isHalted _ = False
runProgram :: Program -> Maybe Input -> Program
runProgram p@HALTED{} _ = p
runProgram p@(WAITING m c o) Nothing = p
runProgram (WAITING m c o) mi = runProgram (RUNNING m c o) mi
runProgram p@(RUNNING m' pc _) i =
let inst = parseInstruction m' pc
(p', input) = executeInstruction i p inst in
runProgram p' input
parseInstruction :: Memory -> 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 IMMEDIATE a else POSITION (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 :: Maybe Input
-> Program
-> Instruction
-> (Program, Maybe Input)
executeInstruction mi p@(HALTED _) _ = (p, mi)
executeInstruction Nothing p@WAITING{} _ = (p, Nothing)
executeInstruction (Just input) p@(WAITING m pc o) i =
executeInstruction (Just input) (RUNNING m pc o) i -- try running again
executeInstruction mi (RUNNING p pc outputs) i =
case i of
ADD (POSITION a) (POSITION b) c ->
(RUNNING (p V.// [(c, (p V.! a) + (p V.! b))]) (pc + 4) outputs, mi)
ADD (POSITION a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, (p V.! a) + b)]) (pc + 4) outputs, mi)
ADD (IMMEDIATE a) (POSITION b) c ->
(RUNNING (p V.// [(c, a + (p V.! b))]) (pc + 4) outputs, mi)
ADD (IMMEDIATE a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, a + b)]) (pc + 4) outputs, mi)
MUL (POSITION a) (POSITION b) c ->
(RUNNING (p V.// [(c, (p V.! a) * (p V.! b))]) (pc + 4) outputs, mi)
MUL (POSITION a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, (p V.! a) * b)]) (pc + 4) outputs, mi)
MUL (IMMEDIATE a) (POSITION b) c ->
(RUNNING (p V.// [(c, a * (p V.! b))]) (pc + 4) outputs, mi)
MUL (IMMEDIATE a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, a * b)]) (pc + 4) outputs, mi)
STORE a -> case mi of
Nothing -> (WAITING p pc outputs, mi)
Just b -> (RUNNING (p V.// [(a, b)]) (pc + 2) outputs, Nothing)
LOAD a -> (RUNNING p (pc + 2) (Just $ p V.! a), mi)
JMPT (POSITION a) (POSITION b) ->
(RUNNING p (if (p V.! a) /= 0 then fromInteger (p V.! b) else pc + 3) outputs, mi)
JMPT (POSITION a) (IMMEDIATE b) ->
(RUNNING p (if (p V.! a) /= 0 then fromInteger b else pc + 3) outputs, mi)
JMPT (IMMEDIATE a) (POSITION b) ->
(RUNNING p (if a /= 0 then fromInteger (p V.! b) else pc + 3) outputs, mi)
JMPT (IMMEDIATE a) (IMMEDIATE b) ->
(RUNNING p (if a /= 0 then fromInteger b else pc + 3) outputs, mi)
JMPF (POSITION a) (POSITION b) ->
(RUNNING p (if (p V.! a) == 0 then fromInteger (p V.! b) else pc + 3) outputs, mi)
JMPF (POSITION a) (IMMEDIATE b) ->
(RUNNING p (if (p V.! a) == 0 then fromInteger b else pc + 3) outputs, mi)
JMPF (IMMEDIATE a) (POSITION b) ->
(RUNNING p (if a == 0 then fromInteger (p V.! b) else pc + 3) outputs, mi)
JMPF (IMMEDIATE a) (IMMEDIATE b) ->
(RUNNING p (if a == 0 then fromInteger b else pc + 3) outputs, mi)
LT' (POSITION a) (POSITION b) c ->
(RUNNING (p V.// [(c, if (p V.! a) < (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi)
LT' (POSITION a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, if (p V.! a) < b then 1 else 0)]) (pc + 4) outputs, mi)
LT' (IMMEDIATE a) (POSITION b) c ->
(RUNNING (p V.// [(c, if a < (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi)
LT' (IMMEDIATE a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, if a < b then 1 else 0)]) (pc + 4) outputs, mi)
EQ' (POSITION a) (POSITION b) c ->
(RUNNING (p V.// [(c, if (p V.! a) == (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi)
EQ' (POSITION a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, if (p V.! a) == b then 1 else 0)]) (pc + 4) outputs, mi)
EQ' (IMMEDIATE a) (POSITION b) c ->
(RUNNING (p V.// [(c, if a == (p V.! b) then 1 else 0)]) (pc + 4) outputs, mi)
EQ' (IMMEDIATE a) (IMMEDIATE b) c ->
(RUNNING (p V.// [(c, if a == b then 1 else 0)]) (pc + 4) outputs, mi)
HALT -> (HALTED (fromJust outputs), mi)
extractHead :: [a] -> Maybe (a, [a])
extractHead [] = Nothing
extractHead (x:xs) = Just (x, xs)
Write Preview
Loading…
Cancel
Save