4 changed files with 234 additions and 0 deletions
@ -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 |
@ -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) |
@ -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) |
Loading…
Reference in new issue